diff --git a/src/absil/il.fs b/src/absil/il.fs index f097080bae9..3d8f458ad8f 100755 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -38,8 +38,6 @@ let runningOnMono = let _ = if logging then dprintn "* warning: Il.logging is on" -let isNil x = match x with [] -> true | _ -> false -let nonNil x = match x with [] -> false | _ -> true let int_order = LanguagePrimitives.FastGenericComparer let notlazy v = Lazy.CreateFromValue v @@ -2639,7 +2637,7 @@ let rec rescopeILTypeSpecQuick scoref (tspec:ILTypeSpec) = let tref = tspec.TypeRef let tinst = tspec.GenericArgs let qtref = qrescope_tref scoref tref - if ILList.isEmpty tinst && isNone qtref then + if ILList.isEmpty tinst && Option.isNone qtref then None (* avoid reallocation in the common case *) else match qtref with @@ -4267,14 +4265,14 @@ let resolveILMethodRefWithRescope r td (mref:ILMethodRef) = let nargs = args.Length let nm = mref.Name let possibles = td.Methods.FindByNameAndArity (nm,nargs) - if isNil possibles then failwith ("no method named "+nm+" found in type "+td.Name); + if List.isEmpty possibles then failwith ("no method named " + nm + " found in type " + td.Name) match possibles |> List.filter (fun md -> mref.CallingConv = md.CallingConv && // REVIEW: this uses equality on ILType. For CMOD_OPTIONAL this is not going to be correct - (md.Parameters,mref.ArgTypes) ||> ILList.lengthsEqAndForall2 (fun p1 p2 -> r p1.Type = p2) && + (md.Parameters,mref.ArgTypes) ||> ILList.lengthsEqAndForall2 (fun p1 p2 -> r p1.Type = p2) && // REVIEW: this uses equality on ILType. For CMOD_OPTIONAL this is not going to be correct - r md.Return.Type = mref.ReturnType) with + r md.Return.Type = mref.ReturnType) with | [] -> failwith ("no method named "+nm+" with appropriate argument types found in type "+td.Name) | [mdef] -> mdef | _ -> failwith ("multiple methods named "+nm+" appear with identical argument types in type "+td.Name) diff --git a/src/absil/illib.fs b/src/absil/illib.fs index e25067f7030..490fe125d52 100644 --- a/src/absil/illib.fs +++ b/src/absil/illib.fs @@ -21,13 +21,8 @@ let (>>>&) (x:int32) (n:int32) = int32 (uint32 x >>> n) let notlazy v = Lazy<_>.CreateFromValue v -let isSome x = match x with None -> false | _ -> true -let isNone x = match x with None -> true | _ -> false -let isNil x = match x with [] -> true | _ -> false -let nonNil x = match x with [] -> false | _ -> true -let isNull (x : 'T) = match (x :> obj) with null -> true | _ -> false -let isNonNull (x : 'T) = match (x :> obj) with null -> false | _ -> true -let nonNull msg x = if isNonNull x then x else failwith ("null: " ^ msg) +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 //--------------------------------------------------------------------- @@ -438,7 +433,7 @@ module String = else None - let hasPrefix s t = isSome (tryDropPrefix s t) + let hasPrefix s t = Option.isSome (tryDropPrefix s t) let dropPrefix s t = match (tryDropPrefix s t) with Some(res) -> res | None -> failwith "dropPrefix" let dropSuffix s t = match (tryDropSuffix s t) with Some(res) -> res | None -> failwith "dropSuffix" diff --git a/src/absil/ilprint.fs b/src/absil/ilprint.fs index b8289f30b0f..6bdbf62c44d 100644 --- a/src/absil/ilprint.fs +++ b/src/absil/ilprint.fs @@ -285,7 +285,7 @@ and goutput_gparam env os (gf: ILGenericParameterDef) = output_parens (output_seq "," (goutput_typ env)) os gf.Constraints and goutput_gparams env os b = - if nonNil b then + if not (List.isEmpty b) then output_string os "<"; output_seq "," (goutput_gparam env) os b; output_string os ">"; () and output_bcc os bcc = diff --git a/src/absil/ilread.fs b/src/absil/ilread.fs index 353b3b114d2..9a9d4ac6786 100644 --- a/src/absil/ilread.fs +++ b/src/absil/ilread.fs @@ -1486,7 +1486,7 @@ let dataEndPoints ctxtH = let rva = ctxt.resourcesAddr + offset res := ("manifest resource", rva) :: !res !res - if isNil dataStartPoints then [] + if List.isEmpty dataStartPoints then [] else let methodRVAs = let res = ref [] @@ -2184,7 +2184,7 @@ and seekReadMemberRefAsMethodDataUncached ctxtH (MemberRefAsMspecIdx (numtypars, and seekReadMemberRefAsMethDataNoVarArgs ctxt numtypars idx : MethodData = let (VarArgMethodData(enclTyp, cc, nm, argtys,varargs, retty,minst)) = seekReadMemberRefAsMethodData ctxt numtypars idx - if isSome varargs then dprintf "ignoring sentinel and varargs in ILMethodDef token signature" + if Option.isSome varargs then dprintf "ignoring sentinel and varargs in ILMethodDef token signature" (MethodData(enclTyp, cc, nm, argtys, retty,minst)) and seekReadMethodSpecAsMethodData ctxt numtypars idx = @@ -3987,7 +3987,7 @@ let OpenILModuleReaderAfterReadingAllBytes infile opts = { modul = modul ilAssemblyRefs = ilAssemblyRefs dispose = (fun () -> ClosePdbReader pdb) } - if isNone pdb && succeeded then + if Option.isNone pdb && succeeded then ilModuleReaderCache.Put(key, ilModuleReader) ilModuleReader diff --git a/src/absil/ilreflect.fs b/src/absil/ilreflect.fs index ce080f66b52..8f6686f8168 100644 --- a/src/absil/ilreflect.fs +++ b/src/absil/ilreflect.fs @@ -1493,7 +1493,7 @@ let rec buildMethodPass3 cenv tref modB (typB:TypeBuilder) emEnv (mdef : ILMetho | ".cctor" | ".ctor" -> let consB = envGetConsB emEnv mref // Constructors can not have generic parameters - assert isNil mdef.GenericParams + assert List.isEmpty mdef.GenericParams // Value parameters let defineParameter (i,attr,name) = consB.DefineParameterAndLog(i+1,attr,name) mdef.Parameters |> ILList.iteri (emitParameter cenv emEnv defineParameter); diff --git a/src/absil/ilwrite.fs b/src/absil/ilwrite.fs index 993b78959b7..ffde7e90234 100644 --- a/src/absil/ilwrite.fs +++ b/src/absil/ilwrite.fs @@ -772,7 +772,7 @@ and GetTypeDescAsTypeRefIdx cenv (scoref,enc,n) = GetTypeRefAsTypeRefIdx cenv (mkILNestedTyRef (scoref,enc,n)) and GetResolutionScopeAsElem cenv (scoref,enc) = - if isNil enc then + if List.isEmpty enc then match scoref with | ILScopeRef.Local -> (rs_Module, 1) | ILScopeRef.Assembly aref -> (rs_AssemblyRef, GetAssemblyRefAsIdx cenv aref) @@ -1205,16 +1205,16 @@ and GenTypeDefPass2 pidx enc cenv (td:ILTypeDef) = // Add entries to auxiliary mapping tables, e.g. Nested, PropertyMap etc. // Note Nested is organised differntly to the others... - if nonNil enc then + if not (List.isEmpty enc) then AddUnsharedRow cenv TableNames.Nested (UnsharedRow [| SimpleIndex (TableNames.TypeDef, tidx) SimpleIndex (TableNames.TypeDef, pidx) |]) |> ignore let props = td.Properties.AsList - if nonNil props then + if not (List.isEmpty props) then AddUnsharedRow cenv TableNames.PropertyMap (GetTypeDefAsPropertyMapRow cenv tidx) |> ignore let events = td.Events.AsList - if nonNil events then + if not (List.isEmpty events) then AddUnsharedRow cenv TableNames.EventMap (GetTypeDefAsEventMapRow cenv tidx) |> ignore // Now generate or assign index numbers for tables referenced by the maps. @@ -1308,7 +1308,7 @@ let GetMethodRefInfoAsMemberRefIdx cenv env ((_,typ,_,_,_,_,_) as minfo) = FindOrAddSharedRow cenv TableNames.MemberRef (MethodRefInfoAsMemberRefRow cenv env fenv minfo) let GetMethodRefInfoAsMethodRefOrDef isAlwaysMethodDef cenv env ((nm,typ:ILType,cc,args,ret,varargs,genarity) as minfo) = - if isNone varargs && (isAlwaysMethodDef || isTypeLocal typ) then + if Option.isNone varargs && (isAlwaysMethodDef || isTypeLocal typ) then if not typ.IsNominal then failwith "GetMethodRefInfoAsMethodRefOrDef: unexpected local tref-typ" try (mdor_MethodDef, GetMethodRefAsMethodDefIdx cenv (mkILMethRefRaw(typ.TypeRef, cc, nm, genarity, args,ret))) with MethodDefNotFound -> (mdor_MemberRef, GetMethodRefInfoAsMemberRefIdx cenv env minfo) @@ -1623,7 +1623,7 @@ module Codebuf = let adjustments = ref [] while (!remainingReqdFixups <> [] || not !doneLast) do - let doingLast = isNil !remainingReqdFixups + let doingLast = List.isEmpty !remainingReqdFixups let origStartOfNoBranchBlock = !origWhere let newStartOfNoBranchBlock = !newWhere @@ -2076,7 +2076,7 @@ module Codebuf = let mkScopeNode cenv (localSigs: _[]) (startOffset,endOffset,ls: ILLocalDebugMapping list,childScopes) = - if (isNil ls || not cenv.generatePdb) then childScopes + if List.isEmpty ls || not cenv.generatePdb then childScopes else [ { Children= Array.ofList childScopes StartOffset=startOffset @@ -2253,7 +2253,7 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = let codeSize = code.Length let methbuf = ByteBuffer.Create (codeSize * 3) // Do we use the tiny format? - if ILList.isEmpty il.Locals && il.MaxStack <= 8 && isNil seh && codeSize < 64 then + if ILList.isEmpty il.Locals && il.MaxStack <= 8 && List.isEmpty seh && codeSize < 64 then // Use Tiny format let alignedCodeSize = align 4 (codeSize + 1) let codePadding = (alignedCodeSize - (codeSize + 1)) @@ -2285,7 +2285,7 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = methbuf.EmitBytes code methbuf.EmitPadding codePadding - if nonNil seh then + if not (List.isEmpty seh) then // Can we use the small exception handling table format? let smallSize = (seh.Length * 12 + 4) let canUseSmall = @@ -2463,7 +2463,7 @@ let rec GetParamAsParamRow cenv _env seq (param: ILParameter) = StringE (GetStringHeapIdxOption cenv param.Name) |] and GenParamPass3 cenv env seq (param: ILParameter) = - if param.IsIn=false && param.IsOut=false && param.IsOptional=false && isNone param.Default && isNone param.Name && isNone param.Marshal + if not param.IsIn && not param.IsOut && not param.IsOptional && Option.isNone param.Default && Option.isNone param.Name && Option.isNone param.Marshal then () else let pidx = AddUnsharedRow cenv TableNames.Param (GetParamAsParamRow cenv env seq param) @@ -2483,7 +2483,7 @@ let GenReturnAsParamRow (returnv : ILReturn) = StringE 0 |] let GenReturnPass3 cenv (returnv: ILReturn) = - if isSome returnv.Marshal || nonNil returnv.CustomAttrs.AsList then + if Option.isSome returnv.Marshal || not (List.isEmpty returnv.CustomAttrs.AsList) then let pidx = AddUnsharedRow cenv TableNames.Param (GenReturnAsParamRow returnv) GenCustomAttrsPass3Or4 cenv (hca_ParamDef,pidx) returnv.CustomAttrs match returnv.Marshal with @@ -2770,7 +2770,7 @@ let rec GenTypeDefPass3 enc cenv (td:ILTypeDef) = match td.Layout with | ILTypeDefLayout.Auto -> () | ILTypeDefLayout.Sequential layout | ILTypeDefLayout.Explicit layout -> - if isSome layout.Pack || isSome layout.Size then + if Option.isSome layout.Pack || Option.isSome layout.Size then AddUnsharedRow cenv TableNames.ClassLayout (UnsharedRow [| UShort (match layout.Pack with None -> uint16 0x0 | Some p -> p) diff --git a/src/fsharp/AttributeChecking.fs b/src/fsharp/AttributeChecking.fs index 661b5ede03d..82c36d3f8fa 100644 --- a/src/fsharp/AttributeChecking.fs +++ b/src/fsharp/AttributeChecking.fs @@ -271,7 +271,7 @@ let private CheckILAttributes g cattrs m = /// Check F# attributes for 'ObsoleteAttribute', 'CompilerMessageAttribute' and 'ExperimentalAttribute', /// returning errors and warnings as data let CheckFSharpAttributes g attribs m = - if isNil attribs then CompleteD + if List.isEmpty attribs then CompleteD else (match TryFindFSharpAttribute g g.attrib_SystemObsolete attribs with | Some(Attrib(_,_,[ AttribStringArg s ],_,_,_,_)) -> @@ -338,12 +338,12 @@ let private CheckProvidedAttributes g m (provAttribs: Tainted @@ -354,13 +354,13 @@ let CheckFSharpAttributesForHidden g attribs = /// Indicate if a list of F# attributes contains 'ObsoleteAttribute'. Used to suppress the item in intellisense. let CheckFSharpAttributesForObsolete g attribs = - nonNil attribs && (HasFSharpAttribute g g.attrib_SystemObsolete attribs) + not (List.isEmpty attribs) && (HasFSharpAttribute g g.attrib_SystemObsolete attribs) /// Indicate if a list of F# attributes contains 'ObsoleteAttribute'. Used to suppress the item in intellisense. /// Also check the attributes for CompilerMessageAttribute, which has an IsHidden argument that allows /// items to be suppressed from intellisense. let CheckFSharpAttributesForUnseen g attribs _m = - nonNil attribs && + not (List.isEmpty attribs) && (CheckFSharpAttributesForObsolete g attribs || CheckFSharpAttributesForHidden g attribs) @@ -402,7 +402,7 @@ let CheckMethInfoAttributes g m tyargsOpt minfo = (fun fsAttribs -> let res = CheckFSharpAttributes g fsAttribs m ++ (fun () -> - if isNone tyargsOpt && HasFSharpAttribute g g.attrib_RequiresExplicitTypeArgumentsAttribute fsAttribs then + if Option.isNone tyargsOpt && HasFSharpAttribute g g.attrib_RequiresExplicitTypeArgumentsAttribute fsAttribs then ErrorD(Error(FSComp.SR.tcFunctionRequiresExplicitTypeArguments(minfo.LogicalName),m)) else CompleteD) diff --git a/src/fsharp/AugmentWithHashCompare.fs b/src/fsharp/AugmentWithHashCompare.fs index 73a548039ca..088f761ac70 100644 --- a/src/fsharp/AugmentWithHashCompare.fs +++ b/src/fsharp/AugmentWithHashCompare.fs @@ -353,7 +353,7 @@ let mkUnionCompare g tcref (tycon:Tycon) = let cref = tcref.MakeNestedUnionCaseRef ucase let m = cref.Range let rfields = ucase.RecdFields - if isNil rfields then None else + if List.isEmpty rfields then None else let mkTest thise thataddre j (argty:RecdField) = mkCallGenericComparisonWithComparerOuter g m argty.FormalType compe @@ -370,10 +370,10 @@ let mkUnionCompare g tcref (tycon:Tycon) = (mkCompareTestConjuncts g m (List.mapi (mkTest thisucve thatucve) rfields))) Some (mkCase(Test.UnionCase(cref,tinst),mbuilder.AddResultTarget(test,SuppressSequencePointAtTarget))) - let nullary,nonNullary = List.partition isNone (List.map mkCase ucases) - if isNil nonNullary then mkZero g m else + let nullary,nonNullary = List.partition Option.isNone (List.map mkCase ucases) + if List.isEmpty nonNullary then mkZero g m else let cases = nonNullary |> List.map (function (Some c) -> c | None -> failwith "mkUnionCompare") - let dflt = if isNil nullary then None else Some (mbuilder.AddResultTarget(mkZero g m,SuppressSequencePointAtTarget)) + let dflt = if List.isEmpty nullary then None else Some (mbuilder.AddResultTarget(mkZero g m,SuppressSequencePointAtTarget)) let dtree = TDSwitch(thise, cases, dflt,m) mbuilder.Close(dtree,m,g.int_ty) @@ -410,7 +410,7 @@ let mkUnionCompareWithComparer g tcref (tycon:Tycon) (_thisv,thise) (_thatobjv,t let cref = tcref.MakeNestedUnionCaseRef ucase let m = cref.Range let rfields = ucase.RecdFields - if isNil rfields then None else + if List.isEmpty rfields then None else let mkTest thise thataddre j (argty:RecdField) = mkCallGenericComparisonWithComparerOuter g m argty.FormalType @@ -430,10 +430,10 @@ let mkUnionCompareWithComparer g tcref (tycon:Tycon) (_thisv,thise) (_thatobjv,t Some (mkCase(Test.UnionCase(cref,tinst),mbuilder.AddResultTarget(test,SuppressSequencePointAtTarget))) - let nullary,nonNullary = List.partition isNone (List.map mkCase ucases) - if isNil nonNullary then mkZero g m else + let nullary,nonNullary = List.partition Option.isNone (List.map mkCase ucases) + if List.isEmpty nonNullary then mkZero g m else let cases = nonNullary |> List.map (function (Some c) -> c | None -> failwith "mkUnionCompare") - let dflt = if isNil nullary then None else Some (mbuilder.AddResultTarget(mkZero g m,SuppressSequencePointAtTarget)) + let dflt = if List.isEmpty nullary then None else Some (mbuilder.AddResultTarget(mkZero g m,SuppressSequencePointAtTarget)) let dtree = TDSwitch(thise, cases, dflt,m) mbuilder.Close(dtree,m,g.int_ty) @@ -471,7 +471,7 @@ let mkUnionEquality g tcref (tycon:Tycon) = let cref = tcref.MakeNestedUnionCaseRef ucase let m = cref.Range let rfields = ucase.RecdFields - if isNil rfields then None else + if List.isEmpty rfields then None else let mkTest thise thataddre j (argty:RecdField) = mkCallGenericEqualityEROuter g m argty.FormalType @@ -490,10 +490,10 @@ let mkUnionEquality g tcref (tycon:Tycon) = Some (mkCase(Test.UnionCase(cref,tinst), mbuilder.AddResultTarget(test, SuppressSequencePointAtTarget))) - let nullary,nonNullary = List.partition isNone (List.map mkCase ucases) - if isNil nonNullary then mkTrue g m else + let nullary,nonNullary = List.partition Option.isNone (List.map mkCase ucases) + if List.isEmpty nonNullary then mkTrue g m else let cases = List.map (function (Some c) -> c | None -> failwith "mkUnionEquality") nonNullary - let dflt = (if isNil nullary then None else Some (mbuilder.AddResultTarget(mkTrue g m,SuppressSequencePointAtTarget))) + let dflt = (if List.isEmpty nullary then None else Some (mbuilder.AddResultTarget(mkTrue g m,SuppressSequencePointAtTarget))) let dtree = TDSwitch(thise, cases, dflt, m) mbuilder.Close(dtree,m,g.bool_ty) @@ -532,7 +532,7 @@ let mkUnionEqualityWithComparer g tcref (tycon:Tycon) (_thisv,thise) thatobje (t let m = cref.Range let rfields = ucase.RecdFields - if isNil rfields then None else + if List.isEmpty rfields then None else let mkTest thise thataddre j (argty:RecdField) = mkCallGenericEqualityWithComparerOuter g m argty.FormalType @@ -553,10 +553,10 @@ let mkUnionEqualityWithComparer g tcref (tycon:Tycon) (_thisv,thise) thatobje (t Some (mkCase(Test.UnionCase(cref,tinst), mbuilder.AddResultTarget (test, SuppressSequencePointAtTarget))) - let nullary,nonNullary = List.partition isNone (List.map mkCase ucases) - if isNil nonNullary then mkTrue g m else + let nullary,nonNullary = List.partition Option.isNone (List.map mkCase ucases) + if List.isEmpty nonNullary then mkTrue g m else let cases = List.map (function (Some c) -> c | None -> failwith "mkUnionEquality") nonNullary - let dflt = if isNil nullary then None else Some (mbuilder.AddResultTarget(mkTrue g m,SuppressSequencePointAtTarget)) + let dflt = if List.isEmpty nullary then None else Some (mbuilder.AddResultTarget(mkTrue g m,SuppressSequencePointAtTarget)) let dtree = TDSwitch(thise, cases, dflt, m) mbuilder.Close(dtree,m,g.bool_ty) @@ -938,7 +938,7 @@ let MakeBindingsForCompareAugmentation g (tycon:Tycon) = if isUnitTy g ty then mkZero g m else let thate = mkCoerceExpr (thatobje, ty, m, g.obj_ty) - mkApps g ((exprForValRef m vref2,vref2.Type), (if isNil tinst then [] else [tinst]), [thise;thate], m) + mkApps g ((exprForValRef m vref2,vref2.Type), (if List.isEmpty tinst then [] else [tinst]), [thise;thate], m) mkLambdas m tps [thisv;thatobjv] (comparee,g.int_ty) let rhs2 = @@ -1012,7 +1012,7 @@ let MakeBindingsForEqualityWithComparerAugmentation g (tycon:Tycon) = if isUnitTy g ty then mkZero g m else let compe = mkILCallGetEqualityComparer g m - mkApps g ((exprForValRef m withcGetHashCodeVal,withcGetHashCodeVal.Type), (if isNil tinst then [] else [tinst]), [thise; compe], m) + mkApps g ((exprForValRef m withcGetHashCodeVal,withcGetHashCodeVal.Type), (if List.isEmpty tinst then [] else [tinst]), [thise; compe], m) mkLambdas m tps [thisv; unitv] (hashe,g.int_ty) @@ -1048,7 +1048,7 @@ let MakeBindingsForEqualsAugmentation g (tycon:Tycon) = let thatv,thate = mkCompGenLocal m "that" ty mkIsInstConditional g m ty thatobje thatv - (mkApps g ((exprForValRef m nocEqualsVal,nocEqualsVal.Type), (if isNil tinst then [] else [tinst]), [thise;thate], m)) + (mkApps g ((exprForValRef m nocEqualsVal,nocEqualsVal.Type), (if List.isEmpty tinst then [] else [tinst]), [thise;thate], m)) (mkFalse g m) mkLambdas m tps [thisv;thatobjv] (equalse,g.bool_ty) @@ -1077,6 +1077,6 @@ let rec TypeDefinitelyHasEquality g ty = isAppTy g ty && let tcref,tinst = destAppTy g ty // Give a good error for structural types excluded from the equality relation because of their fields - not (TyconIsCandidateForAugmentationWithEquals g tcref.Deref && isNone tcref.GeneratedHashAndEqualsWithComparerValues) && + not (TyconIsCandidateForAugmentationWithEquals g tcref.Deref && Option.isNone tcref.GeneratedHashAndEqualsWithComparerValues) && // Check the (possibly inferred) structural dependencies (tinst, tcref.TyparsNoRange) ||> List.lengthsEqAndForall2 (fun ty tp -> not tp.EqualityConditionalOn || TypeDefinitelyHasEquality g ty) diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 99966e12aaf..ca4f6ebd000 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -3252,7 +3252,7 @@ let PostParseModuleImpl (_i,defaultNamespace,isLastCompiland,filename,impl) = | SynModuleDecl.NestedModule(_) :: _ -> errorR(Error(FSComp.SR.noEqualSignAfterModule(),trimRangeToLine m)) | _ -> errorR(Error(FSComp.SR.buildMultiFileRequiresNamespaceOrModule(),trimRangeToLine m)) - let modname = ComputeAnonModuleName (nonNil defs) defaultNamespace filename (trimRangeToLine m) + let modname = ComputeAnonModuleName (not (List.isEmpty defs)) defaultNamespace filename (trimRangeToLine m) SynModuleOrNamespace(modname,false,true,defs,PreXmlDoc.Empty,[],None,m) | ParsedImplFileFragment.NamespaceFragment (lid,a,b,c,d,e,m)-> @@ -3280,7 +3280,7 @@ let PostParseModuleSpec (_i,defaultNamespace,isLastCompiland,filename,intf) = | SynModuleSigDecl.NestedModule(_) :: _ -> errorR(Error(FSComp.SR.noEqualSignAfterModule(),m)) | _ -> errorR(Error(FSComp.SR.buildMultiFileRequiresNamespaceOrModule(),m)) - let modname = ComputeAnonModuleName (nonNil defs) defaultNamespace filename (trimRangeToLine m) + let modname = ComputeAnonModuleName (not (List.isEmpty defs)) defaultNamespace filename (trimRangeToLine m) SynModuleOrNamespaceSig(modname,false,true,defs,PreXmlDoc.Empty,[],None,m) | ParsedSigFileFragment.NamespaceFragment (lid,a,b,c,d,e,m)-> @@ -4969,7 +4969,7 @@ module private ScriptPreprocessClosure = // Mark the last file as isLastCompiland. let closureFiles = - if isNil closureFiles then + if List.isEmpty closureFiles then closureFiles else match List.frontAndBack closureFiles with @@ -5232,7 +5232,7 @@ let TypeCheckOneInputEventually // Check if we've got an interface for this fragment let rootSigOpt = rootSigs.TryFind(qualNameOfFile) - if verbose then dprintf "ParsedInput.ImplFile, nm = %s, qualNameOfFile = %s, ?rootSigOpt = %b\n" filename qualNameOfFile.Text (isSome rootSigOpt) + if verbose then dprintf "ParsedInput.ImplFile, nm = %s, qualNameOfFile = %s, ?rootSigOpt = %b\n" filename qualNameOfFile.Text (Option.isSome rootSigOpt) // Check if we've already seen an implementation for this fragment if Zset.contains qualNameOfFile rootImpls then @@ -5244,7 +5244,7 @@ let TypeCheckOneInputEventually let! topAttrs,implFile,tcEnvAtEnd = TypeCheckOneImplFile (tcGlobals,tcState.tcsNiceNameGen,amap,tcState.tcsCcu,checkForErrors,tcConfig.conditionalCompilationDefines,tcSink) tcImplEnv rootSigOpt file - let hadSig = isSome rootSigOpt + let hadSig = Option.isSome rootSigOpt let implFileSigType = SigTypeOfImplFile implFile if verbose then dprintf "done TypeCheckOneImplFile...\n" diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index c6a91ea4aad..c1867acbb52 100644 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -137,7 +137,7 @@ let PrintCompilerOption (CompilerOption(_s,_tag,_spec,_,help) as compilerOption) printfn "" (* newline *) let PrintPublicOptions (heading,opts) = - if nonNil opts then + if not (List.isEmpty opts) then printfn "" printfn "" printfn "\t\t%s" heading diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 21129b89106..f51bb3a8538 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -977,7 +977,7 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) permitWeakResolution ndeep // - Neither type contributes any methods OR // - We have the special case "decimal<_> * decimal". In this case we have some // possibly-relevant methods from "decimal" but we ignore them in this case. - (isNil minfos || (isSome (GetMeasureOfType g argty1) && isDecimalTy g argty2)) in + (List.isEmpty minfos || (Option.isSome (GetMeasureOfType g argty1) && isDecimalTy g argty2)) in checkRuleAppliesInPreferenceToMethods argty1 argty2 || checkRuleAppliesInPreferenceToMethods argty2 argty1) -> @@ -1268,7 +1268,7 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) permitWeakResolution ndeep let frees = GetFreeTyparsOfMemberConstraint csenv traitInfo // If there's nothing left to learn then raise the errors - (if (permitWeakResolution && isNil support) || isNil frees then errors + (if (permitWeakResolution && List.isEmpty support) || List.isEmpty frees then errors // Otherwise re-record the trait waiting for canonicalization else AddMemberConstraint csenv ndeep m2 trace traitInfo support frees) ++ (fun () -> ResultD TTraitUnsolved) ) @@ -1355,7 +1355,7 @@ and TransactMemberConstraintSolution traitInfo trace sln = /// That is, don't perform resolution if more nominal information may influence the set of available overloads and GetRelevantMethodsForTrait (csenv:ConstraintSolverEnv) permitWeakResolution nm (TTrait(tys,_,memFlags,argtys,rty,soln) as traitInfo) : MethInfo list = let results = - if permitWeakResolution || isNil (GetSupportOfMemberConstraint csenv traitInfo) then + if permitWeakResolution || List.isEmpty (GetSupportOfMemberConstraint csenv traitInfo) then let m = csenv.m let minfos = match memFlags.MemberKind with @@ -1408,11 +1408,11 @@ and SolveRelevantMemberConstraintsForTypar (csenv:ConstraintSolverEnv) ndeep per let cxst = csenv.SolverState.ExtraCxs let tpn = tp.Stamp let cxs = cxst.FindAll tpn - if isNil cxs then ResultD false else + if List.isEmpty cxs then ResultD false else cxs |> List.iter (fun _ -> cxst.Remove tpn); - assert (isNil (cxst.FindAll tpn)); + assert (List.isEmpty (cxst.FindAll tpn)) match trace with | NoTrace -> () @@ -1674,7 +1674,7 @@ and SolveTypeSupportsComparison (csenv:ConstraintSolverEnv) ndeep m2 trace ty = elif (isAppTy g ty && let tcref = tcrefOfAppTy g ty AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare g tcref.Deref && - isNone tcref.GeneratedCompareToWithComparerValues) then + Option.isNone tcref.GeneratedCompareToWithComparerValues) then ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison3(NicePrint.minimalStringOfType denv ty),m,m2)) @@ -1702,7 +1702,7 @@ and SolveTypSupportsEquality (csenv:ConstraintSolverEnv) ndeep m2 trace ty = // Give a good error for structural types excluded from the equality relation because of their fields if (AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals g tcref.Deref && - isNone tcref.GeneratedHashAndEqualsWithComparerValues) then + Option.isNone tcref.GeneratedHashAndEqualsWithComparerValues) then ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality3(NicePrint.minimalStringOfType denv ty),m,m2)) @@ -1855,7 +1855,7 @@ and CanMemberSigsMatchUpToCheck Iterate2D unifyTypes minst uminst ++ (fun () -> - if not (permitOptArgs || isNil(unnamedCalledOptArgs)) then ErrorD(Error(FSComp.SR.csOptionalArgumentNotPermittedHere(),m)) else + if not (permitOptArgs || List.isEmpty unnamedCalledOptArgs) then ErrorD(Error(FSComp.SR.csOptionalArgumentNotPermittedHere(),m)) else let calledObjArgTys = minfo.GetObjArgTypes(amap, m, minst) @@ -1909,10 +1909,10 @@ and CanMemberSigsMatchUpToCheck match reqdRetTyOpt with | None -> CompleteD | Some _ when minfo.IsConstructor -> CompleteD - | Some _ when not alwaysCheckReturn && isNil unnamedCalledOutArgs -> CompleteD + | Some _ when not alwaysCheckReturn && List.isEmpty unnamedCalledOutArgs -> CompleteD | Some reqdRetTy -> let methodRetTy = - if isNil unnamedCalledOutArgs then + if List.isEmpty unnamedCalledOutArgs then methodRetTy else let outArgTys = unnamedCalledOutArgs |> List.map (fun calledArg -> destByrefTy g calledArg.CalledArgumentType) @@ -1995,10 +1995,10 @@ and ReportNoCandidatesError (csenv:ConstraintSolverEnv) (nUnnamedCallerArgs,nNam // No version accessible | ([],others),_,_,_,_ -> - if nonNil others then - ErrorD (Error (FSComp.SR.csMemberIsNotAccessible2(methodName, (ShowAccessDomain ad)), m)) - else + if List.isEmpty others then ErrorD (Error (FSComp.SR.csMemberIsNotAccessible(methodName, (ShowAccessDomain ad)), m)) + else + ErrorD (Error (FSComp.SR.csMemberIsNotAccessible2(methodName, (ShowAccessDomain ad)), m)) | _,([],(cmeth::_)),_,_,_ -> // Check all the argument types. @@ -2415,7 +2415,6 @@ let EliminateConstraintsForGeneralizedTypars csenv trace (generalizedTypars: Typ let tpn = tp.Stamp let cxst = csenv.SolverState.ExtraCxs let cxs = cxst.FindAll tpn - if isNil cxs then () else cxs |> List.iter (fun cx -> cxst.Remove tpn match trace with diff --git a/src/fsharp/DetupleArgs.fs b/src/fsharp/DetupleArgs.fs index 8b96ebb196d..d680760d040 100644 --- a/src/fsharp/DetupleArgs.fs +++ b/src/fsharp/DetupleArgs.fs @@ -406,7 +406,7 @@ type CallPattern = TupleStructure list let callPatternOrder = (compare : CallPattern -> CallPattern -> int) let argsCP exprs = List.map exprTS exprs let noArgsCP = [] -let isTrivialCP xs = (isNil xs) +let inline isTrivialCP xs = List.isEmpty xs let rec minimalCallPattern callPattern = match callPattern with diff --git a/src/fsharp/ExtensionTyping.fs b/src/fsharp/ExtensionTyping.fs index fa2a3e773f7..c7739e18c9a 100755 --- a/src/fsharp/ExtensionTyping.fs +++ b/src/fsharp/ExtensionTyping.fs @@ -1251,6 +1251,6 @@ module internal ExtensionTyping = /// Check if this is a direct reference to a non-embedded generated type. This is not permitted at any name resolution. /// We check by seeing if the type is absent from the remapping context. let IsGeneratedTypeDirectReference (st: Tainted, m) = - st.PUntaint((fun st -> st.TryGetTyconRef() |> isNone), m) + st.PUntaint((fun st -> st.TryGetTyconRef() |> Option.isNone), m) #endif diff --git a/src/fsharp/FSharp.Core/option.fs b/src/fsharp/FSharp.Core/option.fs index 391355aab1c..3bca435ce6b 100644 --- a/src/fsharp/FSharp.Core/option.fs +++ b/src/fsharp/FSharp.Core/option.fs @@ -11,13 +11,13 @@ namespace Microsoft.FSharp.Core let get option = match option with None -> invalidArg "option" (SR.GetString(SR.optionValueWasNone)) | Some x -> x [] - let isSome option = match option with None -> false | Some _ -> true + let inline isSome option = match option with None -> false | Some _ -> true [] - let isNone option = match option with None -> true | Some _ -> false + let inline isNone option = match option with None -> true | Some _ -> false [] - let count option = match option with None -> 0 | Some _ -> 1 + let count option = match option with None -> 0 | Some _ -> 1 [] let fold<'T,'State> f (s:'State) (inp: option<'T>) = match inp with None -> s | Some x -> f s x diff --git a/src/fsharp/FSharp.Core/option.fsi b/src/fsharp/FSharp.Core/option.fsi index 27432956f03..3225893e284 100644 --- a/src/fsharp/FSharp.Core/option.fsi +++ b/src/fsharp/FSharp.Core/option.fsi @@ -11,18 +11,17 @@ namespace Microsoft.FSharp.Core [] /// Basic operations on options. module Option = - /// Returns true if the option is not None. /// The input option. /// True if the option is not None. [] - val isSome: option:'T option -> bool + val inline isSome: option:'T option -> bool /// Returns true if the option is None. /// The input option. /// True if the option is None. [] - val isNone: option:'T option -> bool + val inline isNone: option:'T option -> bool /// Gets the value associated with the option. /// The input option. diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 080bc1405ae..eec92b5b07c 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -1335,7 +1335,7 @@ type CodeGenBuffer(m:range, member cgbuf.GetCurrentStack() = stack member cgbuf.AssertEmptyStack() = - if nonNil stack then + if not (List.isEmpty stack) then let msg = sprintf "stack flush didn't work, or extraneous expressions left on stack before stack restore, methodName = %s, stack = %+A, m = %s" methodName stack (stringOfRange m) System.Diagnostics.Debug.Assert(false, msg) warning(InternalError(msg,m)) @@ -1369,7 +1369,7 @@ type CodeGenBuffer(m:range, cgbuf.EnsureNopBetweenDebugPoints() let attr = GenILSourceMarker mgbuf.cenv.g src - assert(isSome(attr)) + assert(Option.isSome attr) let i = I_seqpoint (Option.get attr) codebuf.Add i // Save the first sequence point away to snap it to the top of the method @@ -1476,7 +1476,7 @@ type CodeGenBuffer(m:range, for kvp in codeLabelToCodeLabel -> (kvp.Key, lab2pc 0 kvp.Key) ] ), instrs, ResizeArray.toList exnSpecs, - isSome seqpoint + Option.isSome seqpoint module CG = let EmitInstr (cgbuf:CodeGenBuffer) pops pushes i = cgbuf.EmitInstr(pops,pushes,i) @@ -2567,7 +2567,7 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = let mspec = mkILMethSpec (mspec.MethodRef, boxity,ilEnclArgTys,ilMethArgTys) // "Unit" return types on static methods become "void" - let mustGenerateUnitAfterCall = isNone returnTy + let mustGenerateUnitAfterCall = Option.isNone returnTy let ccallInfo = match valUseFlags with @@ -2577,7 +2577,7 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = let isBaseCall = match valUseFlags with VSlotDirectCall -> true | _ -> false let isTailCall = - if isNil laterArgs && not isSelfInit then + if List.isEmpty laterArgs && not isSelfInit then let isDllImport = IsValRefIsDllImport cenv.g vref let hasByrefArg = mspec.FormalArgTypes |> ILList.exists (function ILType.Byref _ -> true | _ -> false) let makesNoCriticalTailcalls = vref.MakesNoCriticalTailcalls @@ -2628,8 +2628,8 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = if cenv.opts.generateDebugSymbols && mustGenerateUnitAfterCall && (isTailCall = Normalcall) then CG.EmitInstrs cgbuf (pop 0) Push0 [ AI_nop ] - if isNil laterArgs then - assert isNil whereSaved + if List.isEmpty laterArgs then + assert List.isEmpty whereSaved // Generate the "unit" value if necessary CommitCallSequel cenv eenv m eenv.cloc cgbuf mustGenerateUnitAfterCall sequel else @@ -2656,7 +2656,7 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = and CanTailcall (hasStructObjArg, ccallInfo, withinSEH, hasByrefArg, mustGenerateUnitAfterCall, isDllImport, isSelfInit, makesNoCriticalTailcalls, sequel) = // Can't tailcall with a struct object arg since it involves a byref // Can't tailcall with a .NET 2.0 generic constrained call since it involves a byref - if not hasStructObjArg && isNone ccallInfo && not withinSEH && not hasByrefArg && not isDllImport && not isSelfInit && not makesNoCriticalTailcalls && + if not hasStructObjArg && Option.isNone ccallInfo && not withinSEH && not hasByrefArg && not isDllImport && not isSelfInit && not makesNoCriticalTailcalls && // We can tailcall even if we need to generate "unit", as long as we're about to throw the value away anyway as par of the return. // We can tailcall if we don't need to generate "unit", as long as we're about to return. (match sequelIgnoreEndScopes sequel with @@ -3048,7 +3048,7 @@ and GenAsmCode cenv cgbuf eenv (il,tyargs,args,returnTys,m) sequel = errorR(InternalError(sprintf "%s: bad instruction: %A" s i,m)) let modFieldSpec fspec = - if isNil ilTyArgs then + if List.isEmpty ilTyArgs then fspec else {fspec with EnclosingType= @@ -3083,7 +3083,7 @@ and GenAsmCode cenv cgbuf eenv (il,tyargs,args,returnTys,m) sequel = // "Add an I_nop if this is an initonly field to make sure we never recognize it as an lvalue. See mkExprAddrOfExpr." | _ -> - if not (isNil tyargs) then err "Bad polymorphic IL instruction" + if not (List.isEmpty tyargs) then err "Bad polymorphic IL instruction" i) match ilAfterInst,args,sequel,ilReturnTys with @@ -3182,7 +3182,7 @@ and GenAsmCode cenv cgbuf eenv (il,tyargs,args,returnTys,m) sequel = CG.EmitInstrs cgbuf (pop args.Length) (Push ilReturnTys) ilAfterInst // If no return values were specified generate a "unit" - if isNil returnTys then + if List.isEmpty returnTys then GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel else GenSequel cenv eenv.cloc cgbuf sequel @@ -3247,7 +3247,7 @@ and GenILCall cenv cgbuf eenv (virt,valu,newobj,valUseFlags,isDllImport,ilMethRe let isBaseCall = match valUseFlags with VSlotDirectCall -> true | _ -> false let ccallInfo = match valUseFlags with PossibleConstrainedCall ty -> Some ty | _ -> None let boxity = (if valu then AsValue else AsObject) - let mustGenerateUnitAfterCall = (isNil returnTys) + let mustGenerateUnitAfterCall = List.isEmpty returnTys let makesNoCriticalTailcalls = (newobj || not virt) // Don't tailcall for 'newobj', or 'call' to IL code let tail = CanTailcall(valu,ccallInfo,eenv.withinSEH,hasByrefArg,mustGenerateUnitAfterCall,isDllImport,false,makesNoCriticalTailcalls,sequel) @@ -3542,7 +3542,7 @@ and GenObjectExpr cenv cgbuf eenvouter expr (baseType,baseValOpt,basecall,overri let ilxCloSpec = cloinfo.cloSpec let ilCloFreeVars = cloinfo.cloILFreeVars let ilCloGenericFormals = cloinfo.cloILGenericParams - assert(isNil cloinfo.localTypeFuncDirectILGenericParams) + assert (List.isEmpty cloinfo.localTypeFuncDirectILGenericParams) let ilCloGenericActuals = cloinfo.cloSpec.GenericArgs let ilCloRetTy = cloinfo.cloILFormalRetTy let ilCloTypeRef = cloinfo.cloSpec.TypeRef @@ -4230,7 +4230,7 @@ and GenMatch cenv cgbuf eenv (spBind,_exprm,tree,targets,m,ty) sequel = // // In both cases, any instructions that come after this point will be falsely associated with the last branch of the control // prior to the join point. This is base, e.g. see FSharp 1.0 bug 5155 - if nonNil stackAfterJoin then + if not (List.isEmpty stackAfterJoin) then cgbuf.EmitStartOfHiddenCode() GenSequel cenv eenv.cloc cgbuf sequelAfterJoin @@ -4389,7 +4389,7 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau | Test.ArrayLength _ | Test.IsNull | Test.Const(Const.Zero) -> - if List.length cases <> 1 || isNone defaultTargetOpt then failwith "internal error: GenDecisionTreeSwitch: Test.IsInst/isnull/query" + if List.length cases <> 1 || Option.isNone defaultTargetOpt then failwith "internal error: GenDecisionTreeSwitch: Test.IsInst/isnull/query" let bi = match firstDiscrim with | Test.Const(Const.Zero) -> @@ -4564,7 +4564,7 @@ and GenLetRecBinds cenv cgbuf eenv (allBinds: Bindings,m) = let computeFixupsForOneRecursiveVar boundv forwardReferenceSet fixups selfv access set e = match e with | Expr.Lambda _ | Expr.TyLambda _ | Expr.Obj _ -> - let isLocalTypeFunc = (isSome selfv && (IsNamedLocalTypeFuncVal cenv.g (Option.get selfv) e)) + let isLocalTypeFunc = Option.isSome selfv && (IsNamedLocalTypeFuncVal cenv.g (Option.get selfv) e) let selfv = (match e with Expr.Obj _ -> None | _ when isLocalTypeFunc -> None | _ -> Option.map mkLocalValRef selfv) let clo,_,eenvclo = GetIlxClosureInfo cenv m isLocalTypeFunc selfv {eenv with letBoundVars=(mkLocalValRef boundv)::eenv.letBoundVars} e clo.cloFreeVars |> List.iter (fun fv -> @@ -5019,8 +5019,7 @@ and GenEventForProperty cenv eenvForMeth (mspec:ILMethodSpec) (v:Val) ilAttrsTha and ComputeFlagFixupsForMemberBinding cenv (v:Val,memberInfo:ValMemberInfo) = - - if isNil memberInfo.ImplementedSlotSigs then + if List.isEmpty memberInfo.ImplementedSlotSigs then [fixupVirtualSlotFlags] else memberInfo.ImplementedSlotSigs |> List.map (fun slotsig -> @@ -5031,15 +5030,15 @@ and ComputeFlagFixupsForMemberBinding cenv (v:Val,memberInfo:ValMemberInfo) = let useMethodImpl = // REVIEW: it would be good to get rid of this special casing of Compare and GetHashCode during code generation let isCompare = - (isSome tcref.GeneratedCompareToValues && typeEquiv cenv.g oty cenv.g.mk_IComparable_ty) || - (isSome tcref.GeneratedCompareToValues && tyconRefEq cenv.g cenv.g.system_GenericIComparable_tcref otcref) + (Option.isSome tcref.GeneratedCompareToValues && typeEquiv cenv.g oty cenv.g.mk_IComparable_ty) || + (Option.isSome tcref.GeneratedCompareToValues && tyconRefEq cenv.g cenv.g.system_GenericIComparable_tcref otcref) let isGenericEquals = - (isSome tcref.GeneratedHashAndEqualsWithComparerValues && tyconRefEq cenv.g cenv.g.system_GenericIEquatable_tcref otcref) + (Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues && tyconRefEq cenv.g cenv.g.system_GenericIEquatable_tcref otcref) let isStructural = - (isSome tcref.GeneratedCompareToWithComparerValues && typeEquiv cenv.g oty cenv.g.mk_IStructuralComparable_ty) || - (isSome tcref.GeneratedHashAndEqualsWithComparerValues && typeEquiv cenv.g oty cenv.g.mk_IStructuralEquatable_ty) + (Option.isSome tcref.GeneratedCompareToWithComparerValues && typeEquiv cenv.g oty cenv.g.mk_IStructuralComparable_ty) || + (Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues && typeEquiv cenv.g oty cenv.g.mk_IStructuralEquatable_ty) isInterfaceTy cenv.g oty && not isCompare && not isStructural && not isGenericEquals @@ -5118,7 +5117,7 @@ and GenMethodForBinding let hasPreserveSigNamedArg,ilMethodBody,_hasDllImport = match TryFindFSharpAttributeOpt cenv.g cenv.g.attrib_DllImportAttribute v.Attribs with | Some (Attrib(_,_,[ AttribStringArg(dll) ],namedArgs,_,_,m)) -> - if nonNil tps then error(Error(FSComp.SR.ilSignatureForExternalFunctionContainsTypeParameters(),m)) + if not (List.isEmpty tps) then error(Error(FSComp.SR.ilSignatureForExternalFunctionContainsTypeParameters(),m)) let hasPreserveSigNamedArg, mbody = GenPInvokeMethod (v.CompiledName,dll,namedArgs) hasPreserveSigNamedArg, mbody, true @@ -5212,13 +5211,13 @@ and GenMethodForBinding let ilMethTypars = ilTypars |> List.drop mspec.EnclosingType.GenericArgs.Length if memberInfo.MemberFlags.MemberKind = MemberKind.Constructor then - assert (isNil ilMethTypars) + assert (List.isEmpty ilMethTypars) let mdef = mkILCtor (access,ilParams,ilMethodBody) let mdef = { mdef with CustomAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated) } EmitTheMethodDef mdef elif memberInfo.MemberFlags.MemberKind = MemberKind.ClassConstructor then - assert (isNil ilMethTypars) + assert (List.isEmpty ilMethTypars) let mdef = mkILClassCtor ilMethodBody let mdef = { mdef with CustomAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated) } EmitTheMethodDef mdef @@ -5258,7 +5257,7 @@ and GenMethodForBinding match memberInfo.MemberFlags.MemberKind with | (MemberKind.PropertySet | MemberKind.PropertyGet) -> - if nonNil ilMethTypars then + if not (List.isEmpty ilMethTypars) then error(InternalError("A property may not be more generic than the enclosing type - constrain the polymorphism in the expression",v.Range)) // Check if we're compiling the property as a .NET event @@ -5408,7 +5407,7 @@ and GenSetStorage m cgbuf storage = and CommitGetStorageSequel cenv cgbuf eenv m typ localCloInfo storeSequel = match localCloInfo,storeSequel with | Some {contents =NamedLocalIlxClosureInfoGenerator _cloinfo},_ -> error(InternalError("Unexpected generator",m)) - | Some {contents =NamedLocalIlxClosureInfoGenerated cloinfo},Some (tyargs,args,m,sequel) when nonNil tyargs -> + | Some {contents =NamedLocalIlxClosureInfoGenerated cloinfo},Some (tyargs,args,m,sequel) when not (List.isEmpty tyargs) -> let actualRetTy = GenNamedLocalTyFuncCall cenv cgbuf eenv typ cloinfo tyargs m CommitGetStorageSequel cenv cgbuf eenv m actualRetTy None (Some ([],args,m,sequel)) | _, None -> () @@ -5451,7 +5450,7 @@ and GenGetStorageAndSequel cenv cgbuf eenv m (typ,ilTy) storage storeSequel = GenLambda cenv cgbuf eenv false None expr Continue | Some (tyargs',args,m,sequel) -> let specializedExpr = - if isNil args && isNil tyargs' then failwith ("non-lambda at use of method " + mspec.Name) + if List.isEmpty args && List.isEmpty tyargs' then failwith ("non-lambda at use of method " + mspec.Name) MakeApplicationAndBetaReduce cenv.g (expr,exprty,[tyargs'],args,m) GenExpr cenv cgbuf eenv SPSuppress specializedExpr sequel @@ -5498,7 +5497,7 @@ and AllocLocalVal cenv cgbuf v eenv repr scopeMarks = let repr,eenv = let ty = v.Type if isUnitTy cenv.g ty && not v.IsMutable then Null,eenv - elif isSome repr && IsNamedLocalTypeFuncVal cenv.g v (Option.get repr) then + elif Option.isSome repr && IsNamedLocalTypeFuncVal cenv.g v (Option.get repr) then (* known, named, non-escaping type functions *) let cloinfoGenerate eenv = let eenvinner = @@ -5828,7 +5827,7 @@ and GenTopImpl cenv mgbuf mainInfoOpt eenv (TImplFile(qname, _, mexpr, hasExplic cenv.optimizeDuringCodeGen <- optimizeDuringCodeGen // This is used to point the inner classes back to the startup module for initialization purposes - let isFinalFile = isSome mainInfoOpt + let isFinalFile = Option.isSome mainInfoOpt let initClassCompLoc = CompLocForInitClass eenv.cloc let initClassTy = mkILTyForCompLoc initClassCompLoc @@ -6111,8 +6110,8 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = // HOWEVER, if the type doesn't override Object.Equals already. let augmentOverrideMethodDefs = - (if isNone tycon.GeneratedCompareToValues && - isNone tycon.GeneratedHashAndEqualsValues && + (if Option.isNone tycon.GeneratedCompareToValues && + Option.isNone tycon.GeneratedHashAndEqualsValues && tycon.HasInterface cenv.g cenv.g.mk_IComparable_ty && not (tycon.HasOverride cenv.g "Equals" [cenv.g.obj_ty]) && not tycon.IsFSharpInterfaceTycon @@ -6175,7 +6174,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = | None -> None | Some memberInfo -> match name, memberInfo.MemberFlags.MemberKind with - | ("Item" | "op_IndexedLookup"), (MemberKind.PropertyGet | MemberKind.PropertySet) when nonNil (ArgInfosOfPropertyVal cenv.g vref.Deref) -> + | ("Item" | "op_IndexedLookup"), (MemberKind.PropertyGet | MemberKind.PropertySet) when not (List.isEmpty (ArgInfosOfPropertyVal cenv.g vref.Deref)) -> Some( mkILCustomAttribute cenv.g.ilg (mkILTyRef (cenv.g.ilg.traits.ScopeRef,"System.Reflection.DefaultMemberAttribute"),[cenv.g.ilg.typ_String],[ILAttribElem.String(Some(name))],[]) ) | _ -> None) |> Option.toList @@ -6185,7 +6184,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = // DebugDisplayAttribute gets copied to the subtypes generated as part of DU compilation let debugDisplayAttrs,normalAttrs = tycon.Attribs |> List.partition (IsMatchingFSharpAttribute cenv.g cenv.g.attrib_DebuggerDisplayAttribute) let securityAttrs,normalAttrs = normalAttrs |> List.partition (fun a -> IsSecurityAttribute cenv.g cenv.amap cenv.casApplied a m) - let generateDebugDisplayAttribute = not cenv.g.compilingFslib && tycon.IsUnionTycon && isNil debugDisplayAttrs + let generateDebugDisplayAttribute = not cenv.g.compilingFslib && tycon.IsUnionTycon && List.isEmpty debugDisplayAttrs let generateDebugProxies = (not (tyconRefEq cenv.g tcref cenv.g.unit_tcr_canon) && not (HasFSharpAttribute cenv.g cenv.g.attrib_DebuggerTypeProxyAttribute tycon.Attribs)) @@ -6699,7 +6698,7 @@ and GenExnDef cenv mgbuf eenv m (exnc:Tycon) = // In compiled code, all exception types get a parameterless constructor for use with XML serialization // This does default-initialization of all fields let ilCtorDefNoArgs = - if nonNil fieldNamesAndTypes then + if not (List.isEmpty fieldNamesAndTypes) then [ mkILSimpleStorageCtor(None, Some cenv.g.ilg.tspec_Exception, ilThisTy, [], reprAccess) ] else [] diff --git a/src/fsharp/InfoReader.fs b/src/fsharp/InfoReader.fs index 7afd9eefdc2..f0697622b67 100644 --- a/src/fsharp/InfoReader.fs +++ b/src/fsharp/InfoReader.fs @@ -280,13 +280,13 @@ type InfoReader(g:TcGlobals, amap:Import.ImportMap) = let einfos = ComputeImmediateIntrinsicEventsOfType (optFilter,ad) m typ let rfinfos = GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter,ad) m typ match acc with - | Some(MethodItem(inheritedMethSets)) when nonNil minfos -> Some(MethodItem (minfos::inheritedMethSets)) - | _ when nonNil minfos -> Some(MethodItem ([minfos])) - | Some(PropertyItem(inheritedPropSets)) when nonNil pinfos -> Some(PropertyItem(pinfos::inheritedPropSets)) - | _ when nonNil pinfos -> Some(PropertyItem([pinfos])) - | _ when nonNil finfos -> Some(ILFieldItem(finfos)) - | _ when nonNil einfos -> Some(EventItem(einfos)) - | _ when nonNil rfinfos -> + | Some(MethodItem(inheritedMethSets)) when not (List.isEmpty minfos) -> Some(MethodItem (minfos::inheritedMethSets)) + | _ when not (List.isEmpty minfos) -> Some(MethodItem ([minfos])) + | Some(PropertyItem(inheritedPropSets)) when not (List.isEmpty pinfos) -> Some(PropertyItem(pinfos::inheritedPropSets)) + | _ when not (List.isEmpty pinfos) -> Some(PropertyItem([pinfos])) + | _ when not (List.isEmpty finfos) -> Some(ILFieldItem(finfos)) + | _ when not (List.isEmpty einfos) -> Some(EventItem(einfos)) + | _ when not (List.isEmpty rfinfos) -> match rfinfos with | [single] -> Some(RecdFieldItem(single)) | _ -> failwith "Unexpected multiple fields with the same name" // Because an explicit name (i.e., nm) was supplied, there will be only one element at most. diff --git a/src/fsharp/InnerLambdasToTopLevelFuncs.fs b/src/fsharp/InnerLambdasToTopLevelFuncs.fs index 40bf6bbb8a8..447896a1a7e 100644 --- a/src/fsharp/InnerLambdasToTopLevelFuncs.fs +++ b/src/fsharp/InnerLambdasToTopLevelFuncs.fs @@ -201,7 +201,7 @@ module Pass1_DetermineTLRAndArities = let nFormals = vss.Length let nMaxApplied = GetMaxNumArgsAtUses xinfo f let arity = Operators.min nFormals nMaxApplied - if atTopLevel || arity<>0 || nonNil tps then Some (f,arity) + if atTopLevel || arity<>0 || not (List.isEmpty tps) then Some (f,arity) else None /// Check if f involves any value recursion (so can skip those). @@ -935,7 +935,7 @@ module Pass4_RewriteAssembly = /// collect Top* repr bindings - if needed... #if TLR_LIFT let LiftTopBinds isRec _penv z binds = - let isTopBind (bind: Binding) = isSome bind.Var.ValReprInfo + let isTopBind (bind: Binding) = Option.isSome bind.Var.ValReprInfo let topBinds,otherBinds = FlatList.partition isTopBind binds let liftTheseBindings = !liftTLR && // lifting enabled @@ -1087,7 +1087,7 @@ module Pass4_RewriteAssembly = let args = aenvExprs @ args mkApps penv.g ((exprForVal m fHat, fHat.Type),[tys],args,m) (* change, direct fHat call with closure (reqdTypars,aenvs) *) | _ -> - if isNil tys && isNil args then + if List.isEmpty tys && List.isEmpty args then fx else Expr.App (fx,fty,tys,args,m) (* no change, f is expr *) diff --git a/src/fsharp/LexFilter.fs b/src/fsharp/LexFilter.fs index 5ef87ac8f58..19f84669aaa 100755 --- a/src/fsharp/LexFilter.fs +++ b/src/fsharp/LexFilter.fs @@ -1153,7 +1153,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // Balancing rule. Every 'done' terminates all surrounding blocks up to a CtxtDo, and will be swallowed by // terminating the corresponding CtxtDo in the rule below. let tokenForcesHeadContextClosure token stack = - nonNil stack && + not (List.isEmpty stack) && match token with | Parser.EOF _ -> true | SEMICOLON_SEMICOLON -> not (tokenBalancesHeadContext token stack) diff --git a/src/fsharp/LowerCallsAndSeqs.fs b/src/fsharp/LowerCallsAndSeqs.fs index 34289568ad8..24542ecf091 100644 --- a/src/fsharp/LowerCallsAndSeqs.fs +++ b/src/fsharp/LowerCallsAndSeqs.fs @@ -386,7 +386,7 @@ let LowerSeqExpr g amap overallExpr = let tgl = targets |> Array.map (fun (TTarget(_vs,e,_spTarget)) -> Lower false isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel e) |> Array.toList // LIMITATION: non-trivial pattern matches involving or-patterns or active patterns where bindings can't be // transferred to the r.h.s. are not yet compiled. - if tgl |> List.forall isSome then + if tgl |> List.forall Option.isSome then let tgl = List.map Option.get tgl let labs = tgl |> List.collect (fun res -> res.labels) let stateVars = tgl |> List.collect (fun res -> res.stateVars) @@ -400,8 +400,8 @@ let LowerSeqExpr g amap overallExpr = gtg,dispose,checkDispose) |> List.unzip3 let generate = primMkMatch (spBind,exprm,pt,Array.ofList gtgs,m,ty) - let dispose = if isNil disposals then mkUnit g m else List.reduce (mkCompGenSequential m) disposals - let checkDispose = if isNil checkDisposes then mkFalse g m else List.reduce (mkCompGenSequential m) checkDisposes + let dispose = if List.isEmpty disposals then mkUnit g m else List.reduce (mkCompGenSequential m) disposals + let checkDispose = if List.isEmpty checkDisposes then mkFalse g m else List.reduce (mkCompGenSequential m) checkDisposes generate,dispose,checkDispose) labels=labs stateVars = stateVars diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index d00e2e217f6..6941a888938 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -145,7 +145,7 @@ let AdjustCalledArgType (infoReader:InfoReader) isConstraint (calledArg: CalledA let calledArgTy = let adjustDelegateTy calledTy = let (SigOfFunctionForDelegate(_,delArgTys,_,fty)) = GetSigOfFunctionForDelegate infoReader calledTy m AccessibleFromSomeFSharpCode - let delArgTys = (if isNil delArgTys then [g.unit_ty] else delArgTys) + let delArgTys = if List.isEmpty delArgTys then [g.unit_ty] else delArgTys if (fst (stripFunTy g callerArgTy)).Length = delArgTys.Length then fty else calledArgTy @@ -388,11 +388,11 @@ type CalledMeth<'T> member x.NumArgSets = x.ArgSets.Length - member x.HasOptArgs = nonNil x.UnnamedCalledOptArgs - member x.HasOutArgs = nonNil x.UnnamedCalledOutArgs + member x.HasOptArgs = not (List.isEmpty x.UnnamedCalledOptArgs) + member x.HasOutArgs = not (List.isEmpty x.UnnamedCalledOutArgs) member x.UsesParamArrayConversion = x.ArgSets |> List.exists (fun argSet -> argSet.ParamArrayCalledArgOpt.IsSome) member x.ParamArrayCalledArgOpt = x.ArgSets |> List.tryPick (fun argSet -> argSet.ParamArrayCalledArgOpt) - member x.ParamArrayCallerArgs = x.ArgSets |> List.tryPick (fun argSet -> if isSome argSet.ParamArrayCalledArgOpt then Some argSet.ParamArrayCallerArgs else None ) + member x.ParamArrayCallerArgs = x.ArgSets |> List.tryPick (fun argSet -> if Option.isSome argSet.ParamArrayCalledArgOpt then Some argSet.ParamArrayCallerArgs else None ) member x.ParamArrayElementType = assert (x.UsesParamArrayConversion) x.ParamArrayCalledArgOpt.Value.CalledArgumentType |> destArrayTy x.amap.g @@ -401,7 +401,7 @@ type CalledMeth<'T> member x.NumCalledTyArgs = x.CalledTyArgs.Length member x.NumCallerTyArgs = x.CallerTyArgs.Length - member x.AssignsAllNamedArgs = isNil x.UnassignedNamedArgs + member x.AssignsAllNamedArgs = List.isEmpty x.UnassignedNamedArgs member x.HasCorrectArity = (x.NumCalledTyArgs = x.NumCallerTyArgs) && @@ -533,11 +533,11 @@ let TakeObjAddrForMethodCall g amap (minfo:MethInfo) isMutable m objArgs f = match objArgs with | [objArgExpr] -> let objArgTy = tyOfExpr g objArgExpr - let wrap,objArgExpr' = mkExprAddrOfExpr g mustTakeAddress (isSome ccallInfo) isMutable objArgExpr None m + let wrap,objArgExpr' = mkExprAddrOfExpr g mustTakeAddress (Option.isSome ccallInfo) isMutable objArgExpr None m // Extension members and calls to class constraints may need a coercion for their object argument let objArgExpr' = - if isNone ccallInfo && // minfo.IsExtensionMember && minfo.IsStruct && + if Option.isNone ccallInfo && // minfo.IsExtensionMember && minfo.IsStruct && not (TypeDefinitelySubsumesTypeNoCoercion 0 g amap m minfo.EnclosingType objArgTy) then mkCoerceExpr(objArgExpr',minfo.EnclosingType,m,objArgTy) else @@ -775,7 +775,7 @@ let BuildNewDelegateExpr (eventInfoOpt:EventInfo option, g, amap, delegateTy, in // Try to pull apart an explicit lambda and use it directly // Don't do this in the case where we're adjusting the arguments of a function used to build a .NET-compatible event handler let lambdaContents = - if isSome eventInfoOpt then + if Option.isSome eventInfoOpt then None else tryDestTopLambda g amap topValInfo (f, fty) @@ -796,7 +796,7 @@ let BuildNewDelegateExpr (eventInfoOpt:EventInfo option, g, amap, delegateTy, in | h :: _ when not (isObjTy g h.Type) -> error(nonStandardEventError einfo.EventName m) | h :: t -> [exprForVal m h; mkRefTupledVars g m t] | None -> - if isNil delArgTys then [mkUnit g m] else List.map (exprForVal m) delArgVals + if List.isEmpty delArgTys then [mkUnit g m] else List.map (exprForVal m) delArgVals mkApps g ((f,fty),[],args,m) delArgVals,expr diff --git a/src/fsharp/MethodOverrides.fs b/src/fsharp/MethodOverrides.fs index cc210ade4cb..b446ea5c06d 100644 --- a/src/fsharp/MethodOverrides.fs +++ b/src/fsharp/MethodOverrides.fs @@ -407,7 +407,7 @@ module DispatchSlotChecking = // Check that, for each implemented type, at least one implemented type is implied. This is enough to capture // duplicates. for (_i, reqdTy, m, impliedTys) in reqdTyInfos do - if isInterfaceTy g reqdTy && isNil impliedTys then + if isInterfaceTy g reqdTy && List.isEmpty impliedTys then errorR(Error(FSComp.SR.typrelDuplicateInterface(),m)) // Check that no interface type is implied twice @@ -418,7 +418,7 @@ module DispatchSlotChecking = if i > j then let overlap = ListSet.intersect (TypesFeasiblyEquiv 0 g amap reqdTyRange) impliedTys impliedTys2 overlap |> List.iter (fun overlappingTy -> - if nonNil(GetImmediateIntrinsicMethInfosOfType (None,AccessibleFromSomewhere) g amap reqdTyRange overlappingTy |> List.filter (fun minfo -> minfo.IsVirtual)) then + if not (List.isEmpty (GetImmediateIntrinsicMethInfosOfType (None,AccessibleFromSomewhere) g amap reqdTyRange overlappingTy |> List.filter (fun minfo -> minfo.IsVirtual))) then errorR(Error(FSComp.SR.typrelNeedExplicitImplementation(NicePrint.minimalStringOfType denv (List.head overlap)),reqdTyRange))) // Get the SlotImplSet for each implemented type @@ -605,8 +605,8 @@ module DispatchSlotChecking = // Modify map the slotsig so it is in terms of the type parameters for the overriding method let slotsig = ReparentSlotSigToUseMethodTypars g m overrideBy slotsig - // Record the slotsig via mutation - yield slotsig ] + // Record the slotsig via mutation + yield slotsig ] //if mustOverrideSomething reqdTy overrideBy then // assert nonNil overridenForThisSlotImplSet yield! overridenForThisSlotImplSet ] @@ -634,7 +634,7 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader:InfoReader, nenv, #if EXTENSIONTYPING not tycon.IsProvidedGeneratedTycon && #endif - isNone tycon.GeneratedCompareToValues && + Option.isNone tycon.GeneratedCompareToValues && tycon.HasInterface g g.mk_IComparable_ty && not (tycon.HasOverride g "Equals" [g.obj_ty]) && not tycon.IsFSharpInterfaceTycon @@ -657,7 +657,7 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader:InfoReader, nenv, let hasExplicitObjectGetHashCode = tycon.HasOverride g "GetHashCode" [] let hasExplicitObjectEqualsOverride = tycon.HasOverride g "Equals" [g.obj_ty] - if (isSome tycon.GeneratedHashAndEqualsWithComparerValues) && + if (Option.isSome tycon.GeneratedHashAndEqualsWithComparerValues) && (hasExplicitObjectGetHashCode || hasExplicitObjectEqualsOverride) then errorR(Error(FSComp.SR.typrelExplicitImplementationOfGetHashCodeOrEquals(tycon.DisplayName),m)) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 293a71a58d6..8b057890336 100755 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -70,12 +70,12 @@ let UnionCaseRefsInModuleOrNamespace (modref:ModuleOrNamespaceRef) = /// Try to find a type with a union case of the given name let TryFindTypeWithUnionCase (modref:ModuleOrNamespaceRef) (id: Ident) = modref.ModuleOrNamespaceType.AllEntities - |> QueueList.tryFind (fun tycon -> tycon.GetUnionCaseByName id.idText |> isSome) + |> QueueList.tryFind (fun tycon -> tycon.GetUnionCaseByName id.idText |> Option.isSome) /// Try to find a type with a record field of the given name let TryFindTypeWithRecdField (modref:ModuleOrNamespaceRef) (id: Ident) = modref.ModuleOrNamespaceType.AllEntities - |> QueueList.tryFind (fun tycon -> tycon.GetFieldByName id.idText |> isSome) + |> QueueList.tryFind (fun tycon -> tycon.GetFieldByName id.idText |> Option.isSome) /// Get the active pattern elements defined by a given value, if any let ActivePatternElemsOfValRef vref = @@ -1662,14 +1662,14 @@ let private ResolveObjectConstructorPrim (ncenv:NameResolver) edenv resInfo m ad success (resInfo,Item.DelegateCtor typ) else let ctorInfos = GetIntrinsicConstructorInfosOfType ncenv.InfoReader m typ - if isInterfaceTy g typ && isNil ctorInfos then + if isInterfaceTy g typ && List.isEmpty ctorInfos then success (resInfo, Item.FakeInterfaceCtor typ) else let defaultStructCtorInfo = if (isStructTy g typ && not (isRecdTy g typ) && not (isUnionTy g typ) && not(ctorInfos |> List.exists (fun x -> x.IsNullary))) then [DefaultStructCtor(g,typ)] else [] - if (isNil defaultStructCtorInfo && isNil ctorInfos) || not (isAppTy g typ) then + if (List.isEmpty defaultStructCtorInfo && List.isEmpty ctorInfos) || not (isAppTy g typ) then raze (Error(FSComp.SR.nrNoConstructorsAvailableForType(NicePrint.minimalStringOfType edenv typ),m)) else let ctorInfos = ctorInfos |> List.filter (IsMethInfoAccessible amap m ad) @@ -1838,7 +1838,7 @@ let DecodeFSharpEvent (pinfos:PropInfo list) ad g (ncenv:NameResolver) m = | _ -> // FOUND PROPERTY-AS-EVENT BUT DIDN'T FIND CORRESPONDING ADD/REMOVE METHODS Some(Item.Property (nm,pinfos)) - | pinfo::_ when nonNil pinfos -> + | pinfo::_ when not (List.isEmpty pinfos) -> let nm = CoreDisplayName(pinfo) Some(Item.Property (nm,pinfos)) | _ -> @@ -1894,20 +1894,20 @@ let rec ResolveLongIdentInTypePrim (ncenv:NameResolver) nenv lookupKind (resInfo success(resInfo,Item.RecdField(rfinfo),rest) | _ -> let pinfos = ExtensionPropInfosOfTypeInScope ncenv.InfoReader nenv (optFilter, ad) m typ - if nonNil pinfos && (match lookupKind with LookupKind.Expr -> true | _ -> false) then + if not (List.isEmpty pinfos) && (match lookupKind with LookupKind.Expr -> true | _ -> false) then success (resInfo,Item.Property (nm,pinfos),rest) else let minfos = ExtensionMethInfosOfTypeInScope ncenv.InfoReader nenv optFilter m typ - if nonNil minfos && (match lookupKind with LookupKind.Expr -> true | _ -> false) then + if not (List.isEmpty minfos) && (match lookupKind with LookupKind.Expr -> true | _ -> false) then success (resInfo,Item.MakeMethGroup (nm,minfos),rest) elif isTyparTy g typ then raze (IndeterminateType(unionRanges m id.idRange)) else raze (UndefinedName (depth,FSComp.SR.undefinedNameFieldConstructorOrMember, id,NoPredictions)) let nestedSearchAccessible = - let nestedTypes = GetNestedTypesOfType (ad, ncenv, Some nm, (if isNil rest then typeNameResInfo.StaticArgsInfo else TypeNameResolutionStaticArgsInfo.Indefinite), true, m) typ - if isNil rest then - if isNil nestedTypes then + let nestedTypes = GetNestedTypesOfType (ad, ncenv, Some nm, (if List.isEmpty rest then typeNameResInfo.StaticArgsInfo else TypeNameResolutionStaticArgsInfo.Indefinite), true, m) typ + if List.isEmpty rest then + if List.isEmpty nestedTypes then NoResultsOrUsefulErrors else match typeNameResInfo.ResolutionFlag with @@ -1981,9 +1981,9 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN // Something in a type? let tyconSearch = - let tcrefs = LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, id.idRange, ad, id.idText, (if isNil rest then typeNameResInfo.StaticArgsInfo else TypeNameResolutionStaticArgsInfo.Indefinite), modref) + let tcrefs = LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, id.idRange, ad, id.idText, (if List.isEmpty rest then typeNameResInfo.StaticArgsInfo else TypeNameResolutionStaticArgsInfo.Indefinite), modref) let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo,tcref)) - if nonNil rest then + if not (List.isEmpty rest) then let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, TypeNameResolutionInfo (ResolveTypeNamesToTypeRefs,TypeNameResolutionStaticArgsInfo.Indefinite), PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange) ResolveLongIdentInTyconRefs ncenv nenv LookupKind.Expr (depth+1) m ad rest typeNameResInfo id.idRange tcrefs // Check if we've got some explicit type arguments @@ -2003,7 +2003,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN // Something in a sub-namespace or sub-module let moduleSearch = - if (nonNil rest) then + if not (List.isEmpty rest) then match mty.ModulesAndNamespacesByDemangledName.TryFind(id.idText) with | Some(AccessibleEntityRef ncenv.amap m ad modref submodref) -> let resInfo = resInfo.AddEntity(id.idRange,submodref) @@ -2195,13 +2195,13 @@ let rec ResolvePatternLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv num let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo,tcref)) let tyconSearch = match lid with - | _tn:: rest when nonNil rest -> + | _tn:: rest when not (List.isEmpty rest) -> ResolveLongIdentInTyconRefs (ncenv:NameResolver) nenv LookupKind.Pattern (depth+1) m ad rest numTyArgsOpt id.idRange tcrefs | _ -> NoResultsOrUsefulErrors // Constructor of a type? let ctorSearch = - if isNil rest then + if List.isEmpty rest then tcrefs |> List.map (fun (resInfo,tcref) -> (resInfo,FreshenTycon ncenv m tcref)) |> CollectResults (fun (resInfo,typ) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad typ) @@ -2211,7 +2211,7 @@ let rec ResolvePatternLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv num // Something in a sub-namespace or sub-module or nested-type let moduleSearch = - if nonNil rest then + if not (List.isEmpty rest) then match mty.ModulesAndNamespacesByDemangledName.TryFind(id.idText) with | Some(AccessibleEntityRef ncenv.amap m ad modref submodref) -> let resInfo = resInfo.AddEntity(id.idRange,submodref) @@ -2261,7 +2261,7 @@ let rec ResolvePatternLongIdentPrim sink (ncenv:NameResolver) fullyQualified war (ResolvePatternLongIdentInModuleOrNamespace ncenv nenv numTyArgsOpt ad) let tyconSearch ad = match lid with - | tn:: rest when nonNil rest -> + | tn :: rest when not (List.isEmpty rest) -> let tcrefs = LookupTypeNameInEnvNoArity fullyQualified tn.idText nenv let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty,tcref)) ResolveLongIdentInTyconRefs ncenv nenv LookupKind.Pattern 1 tn.idRange ad rest numTyArgsOpt tn.idRange tcrefs @@ -2274,7 +2274,7 @@ let rec ResolvePatternLongIdentPrim sink (ncenv:NameResolver) fullyQualified war ForceRaise (AtMostOneResult m (tyconSearch AccessibleFromSomeFSharpCode +++ moduleSearch AccessibleFromSomeFSharpCode)) ResolutionInfo.SendToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> true)) - if nonNil rest then error(Error(FSComp.SR.nrIsNotConstructorOrLiteral(),(List.head rest).idRange)) + if not (List.isEmpty rest) then error(Error(FSComp.SR.nrIsNotConstructorOrLiteral(),(List.head rest).idRange)) res @@ -2294,7 +2294,7 @@ let ResolvePatternLongIdent sink (ncenv:NameResolver) warnOnUpper newDef m ad ne // X.ListEnumerator // does not resolve // let ResolveNestedTypeThroughAbbreviation (ncenv:NameResolver) (tcref: TyconRef) m = - if tcref.IsTypeAbbrev && tcref.Typars(m).IsEmpty && isAppTy ncenv.g tcref.TypeAbbrev.Value && isNil (argsOfAppTy ncenv.g tcref.TypeAbbrev.Value) then + if tcref.IsTypeAbbrev && tcref.Typars(m).IsEmpty && isAppTy ncenv.g tcref.TypeAbbrev.Value && List.isEmpty (argsOfAppTy ncenv.g tcref.TypeAbbrev.Value) then tcrefOfAppTy ncenv.g tcref.TypeAbbrev.Value else tcref @@ -2479,7 +2479,7 @@ let rec ResolveFieldInModuleOrNamespace (ncenv:NameResolver) nenv ad (resInfo:Re // search for type-qualified names, e.g. { Microsoft.FSharp.Core.Ref.contents = 1 } let tyconSearch = match lid with - | _tn:: rest when nonNil rest -> + | _tn:: rest when not (List.isEmpty rest) -> let tcrefs = LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, id.idRange, ad, id.idText, TypeNameResolutionStaticArgsInfo.Indefinite, modref) let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty,tcref)) let tyconSearch = ResolveLongIdentInTyconRefs ncenv nenv LookupKind.RecdField (depth+1) m ad rest typeNameResInfo id.idRange tcrefs @@ -2490,7 +2490,7 @@ let rec ResolveFieldInModuleOrNamespace (ncenv:NameResolver) nenv ad (resInfo:Re NoResultsOrUsefulErrors // search for names in nested modules, e.g. { Microsoft.FSharp.Core.contents = 1 } let modulSearch = - if nonNil rest then + if not (List.isEmpty rest) then match modref.ModuleOrNamespaceType.ModulesAndNamespacesByDemangledName.TryFind(id.idText) with | Some(AccessibleEntityRef ncenv.amap m ad modref submodref) -> let resInfo = resInfo.AddEntity(id.idRange,submodref) @@ -2604,7 +2604,7 @@ let ResolveFieldPrim (ncenv:NameResolver) nenv ad typ (mp,id:Ident) allFields = ResolveLongIndentAsModuleOrNamespaceThen ncenv.amap m OpenQualified nenv ad lid (ResolveFieldInModuleOrNamespace ncenv nenv ad) let resInfo,item,rest = ForceRaise (AtMostOneResult m (modulSearch ad +++ tyconSearch ad +++ modulSearch AccessibleFromSomeFSharpCode +++ tyconSearch AccessibleFromSomeFSharpCode)) - if nonNil rest then errorR(Error(FSComp.SR.nrInvalidFieldLabel(),(List.head rest).idRange)) + if not (List.isEmpty rest) then errorR(Error(FSComp.SR.nrInvalidFieldLabel(),(List.head rest).idRange)) [(resInfo,item)] let ResolveField sink ncenv nenv ad typ (mp,id) allFields = @@ -2676,7 +2676,7 @@ let FilterMethodGroups (ncenv:NameResolver) itemRange item staticOnly = match item with | Item.MethodGroup(nm, minfos, orig) -> let minfos = minfos |> List.filter (fun minfo -> - staticOnly = (minfo.GetObjArgTypes(ncenv.amap, itemRange, minfo.FormalMethodInst) |> isNil)) + staticOnly = List.isEmpty (minfo.GetObjArgTypes(ncenv.amap, itemRange, minfo.FormalMethodInst))) Item.MethodGroup(nm, minfos, orig) | item -> item diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index d82a11dc550..8813410143e 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -291,7 +291,7 @@ module private PrintIL = let layoutSetterType (setterRef:ILMethodRef) = let argTypes = setterRef.ArgTypes |> ILList.toList - if isNil argTypes then + if List.isEmpty argTypes then emptyL // shouldn't happen else let frontArgs, lastArg = List.frontAndBack argTypes @@ -1003,7 +1003,7 @@ module private PrintTypes = | _ -> let tpcsL = layoutConstraintsWithInfo denv env tpcs let coreL = sepListL (sepL ",") (List.map (layoutTyparRefWithInfo denv env) typars) - (if prefix || nonNil(tpcs) then nmL ^^ angleL (coreL --- tpcsL) else bracketL coreL --- nmL) + (if prefix || not (List.isEmpty tpcs) then nmL ^^ angleL (coreL --- tpcsL) else bracketL coreL --- nmL) let layoutTyparConstraint denv typars = @@ -1038,7 +1038,7 @@ module private PrintTypes = PrettyTypes.NewPrettyTypars memberToParentInst methTypars methTyparNames let retTy = instType allTyparInst retTy - let argInfos = argInfos |> List.map (fun infos -> if isNil infos then [(denv.g.unit_ty,ValReprInfo.unnamedTopArg1)] else infos |> List.map (map1Of2 (instType allTyparInst))) + let argInfos = argInfos |> List.map (fun infos -> if List.isEmpty infos then [(denv.g.unit_ty,ValReprInfo.unnamedTopArg1)] else infos |> List.map (map1Of2 (instType allTyparInst))) // Also format dummy types corresponding to any type variables on the container to make sure they // aren't chosen as names for displayed variables. @@ -1105,7 +1105,7 @@ module private PrintTastMemberOrVals = stat ++ newL ^^ wordL ":" ^^ tauL | MemberKind.PropertyGetSet -> stat | MemberKind.PropertyGet -> - if isNil argInfos then + if List.isEmpty argInfos then // use error recovery because intellisense on an incomplete file will show this errorR(Error(FSComp.SR.tastInvalidFormForPropertyGetter(),v.Id.idRange)); stat --- wordL v.PropertyName --- wordL "with get" @@ -1117,15 +1117,15 @@ module private PrintTastMemberOrVals = let niceMethodTypars,tauL = layoutMemberType denv v argInfos rty let nameL = mkNameL niceMethodTypars v.PropertyName - stat --- (nameL ^^ wordL ":" ^^ (if isNil argInfos then tauL else tauL --- wordL "with get")) + stat --- (nameL ^^ wordL ":" ^^ (if List.isEmpty argInfos then tauL else tauL --- wordL "with get")) | MemberKind.PropertySet -> - if argInfos.Length <> 1 || isNil argInfos.Head then + if argInfos.Length <> 1 || List.isEmpty argInfos.Head then // use error recovery because intellisense on an incomplete file will show this errorR(Error(FSComp.SR.tastInvalidFormForPropertySetter(),v.Id.idRange)); stat --- wordL v.PropertyName --- wordL "with set" else let argInfos,valueInfo = List.frontAndBack argInfos.Head - let niceMethodTypars,tauL = layoutMemberType denv v (if isNil argInfos then [] else [argInfos]) (fst valueInfo) + let niceMethodTypars,tauL = layoutMemberType denv v (if List.isEmpty argInfos then [] else [argInfos]) (fst valueInfo) let nameL = mkNameL niceMethodTypars v.PropertyName stat --- (nameL ^^ wordL ":" ^^ (tauL --- wordL "with set")) @@ -1606,7 +1606,7 @@ module private TastDefinitionPrinting = iimplsLs,adhocCtorsLs,adhocInstanceLs,adhocStaticLs let memberLs = memberImplementLs @ memberCtorLs @ memberInstanceLs @ memberStaticLs let addMembersAsWithEnd reprL = - if isNil memberLs then reprL + if List.isEmpty memberLs then reprL elif simplified then reprL @@ aboveListL memberLs else reprL @@ (wordL "with" @@-- aboveListL memberLs) @@ wordL "end" @@ -1619,7 +1619,7 @@ module private TastDefinitionPrinting = | TAsmRepr _ | TMeasureableRepr _ | TILObjectRepr _ -> - let brk = nonNil memberLs || breakTypeDefnEqn repr + let brk = not (List.isEmpty memberLs) || breakTypeDefnEqn repr let rhsL = let addReprAccessL l = layoutAccessibility denv tycon.TypeReprAccessibility l let denv = denv.AddAccessibility tycon.TypeReprAccessibility @@ -1655,7 +1655,7 @@ module private TastDefinitionPrinting = | _ -> [] let vsprs = tycon.MembersOfFSharpTyconSorted - |> List.filter (fun v -> isNil (Option.get v.MemberInfo).ImplementedSlotSigs) + |> List.filter (fun v -> List.isEmpty (Option.get v.MemberInfo).ImplementedSlotSigs) |> List.filter (fun v -> v.IsDispatchSlot) |> List.map (fun vref -> PrintTastMemberOrVals.layoutValOrMember denv vref.Deref) let staticValsLs = @@ -1671,7 +1671,7 @@ module private TastDefinitionPrinting = None else let alldecls = applyMaxMembers denv.maxMembers alldecls - let emptyMeasure = match tycon.TypeOrMeasureKind with TyparKind.Measure -> isNil alldecls | _ -> false + let emptyMeasure = match tycon.TypeOrMeasureKind with TyparKind.Measure -> List.isEmpty alldecls | _ -> false if emptyMeasure then None else let declsL = aboveListL alldecls let declsL = match start with Some s -> (wordL s @@-- declsL) @@ wordL "end" | None -> declsL @@ -1745,7 +1745,7 @@ module private InferredSigPrinting = let rec isConcreteNamespace x = match x with | TMDefRec(_,tycons,mbinds,_) -> - nonNil tycons || (mbinds |> List.exists (function ModuleOrNamespaceBinding.Binding _ -> true | ModuleOrNamespaceBinding.Module(x,_) -> not x.IsNamespace)) + not (List.isEmpty tycons) || (mbinds |> List.exists (function ModuleOrNamespaceBinding.Binding _ -> true | ModuleOrNamespaceBinding.Module(x,_) -> not x.IsNamespace)) | TMDefLet _ -> true | TMDefDo _ -> true | TMDefs defs -> defs |> List.exists isConcreteNamespace @@ -1758,7 +1758,7 @@ module private InferredSigPrinting = and imdefsL denv x = aboveListL (x |> List.map (imdefL denv)) and imdefL denv x = - let filterVal (v:Val) = not v.IsCompilerGenerated && isNone v.MemberInfo + let filterVal (v:Val) = not v.IsCompilerGenerated && Option.isNone v.MemberInfo let filterExtMem (v:Val) = v.IsExtensionMember match x with | TMDefRec(_,tycons,mbinds,_) -> @@ -1797,7 +1797,7 @@ module private InferredSigPrinting = if showHeader then // OK, we're not in F# Interactive // Check if this is an outer module with no namespace - if isNil outerPath then + if List.isEmpty outerPath then // If so print a "module" declaration (wordL "module" ^^ nmL) @@ basic else @@ -1836,7 +1836,7 @@ module private PrintData = elif denv.g.unionCaseRefEq c denv.g.cons_ucref then let rec strip = function (Expr.Op (TOp.UnionCase _,_,[h;t],_)) -> h::strip t | _ -> [] listL (dataExprL denv) (strip expr) - elif isNil(args) then + elif List.isEmpty args then wordL c.CaseName else (wordL c.CaseName ++ bracketL (commaListL (dataExprsL denv args))) diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 95634eec40f..9bb4ba0ecde 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -485,7 +485,7 @@ let BindInternalValsToUnknown cenv vs env = let BindTypeVar tyv typeinfo env = { env with typarInfos= (tyv,typeinfo)::env.typarInfos } let BindTypeVarsToUnknown (tps:Typar list) env = - if isNil tps then env else + if List.isEmpty tps then env else // The optimizer doesn't use the type values it could track. // However here we mutate to provide better names for generalized type parameters // The names chosen are 'a', 'b' etc. These are also the compiled names in the IL code @@ -933,36 +933,33 @@ let mkAssemblyCodeValueInfo g instrs argvals tys = let [] localVarSize = 1 -let rec AddTotalSizesAux acc l = match l with [] -> acc | h::t -> AddTotalSizesAux (h.TotalSize + acc) t -let AddTotalSizes l = AddTotalSizesAux 0 l +let inline AddTotalSizes l = l |> List.sumBy (fun x -> x.TotalSize) +let inline AddFunctionSizes l = l |> List.sumBy (fun x -> x.FunctionSize) -let rec AddFunctionSizesAux acc l = match l with [] -> acc | h::t -> AddFunctionSizesAux (h.FunctionSize + acc) t -let AddFunctionSizes l = AddFunctionSizesAux 0 l - -let AddTotalSizesFlat l = l |> FlatList.sumBy (fun x -> x.TotalSize) -let AddFunctionSizesFlat l = l |> FlatList.sumBy (fun x -> x.FunctionSize) +let inline AddTotalSizesFlat l = l |> FlatList.sumBy (fun x -> x.TotalSize) +let inline AddFunctionSizesFlat l = l |> FlatList.sumBy (fun x -> x.FunctionSize) //------------------------------------------------------------------------- // opt list/array combinators - zipping (_,_) return type //------------------------------------------------------------------------- -let rec OrEffects l = match l with [] -> false | h::t -> h.HasEffect || OrEffects t -let OrEffectsFlat l = FlatList.exists (fun x -> x.HasEffect) l +let inline OrEffects l = List.exists (fun x -> x.HasEffect) l +let inline OrEffectsFlat l = FlatList.exists (fun x -> x.HasEffect) l -let rec OrTailcalls l = match l with [] -> false | h::t -> h.MightMakeCriticalTailcall || OrTailcalls t -let OrTailcallsFlat l = FlatList.exists (fun x -> x.MightMakeCriticalTailcall) l +let inline OrTailcalls l = List.exists (fun x -> x.MightMakeCriticalTailcall) l +let inline OrTailcallsFlat l = FlatList.exists (fun x -> x.MightMakeCriticalTailcall) l let rec OptimizeListAux f l acc1 acc2 = match l with | [] -> List.rev acc1, List.rev acc2 | (h ::t) -> - let (x1,x2) = f h + let (x1,x2) = f h OptimizeListAux f t (x1::acc1) (x2::acc2) let OptimizeList f l = OptimizeListAux f l [] [] let OptimizeFlatList f l = l |> FlatList.map f |> FlatList.unzip -let NoExprs : (Expr list * list>)= [],[] +let NoExprs : (Expr list * list>) = [],[] let NoFlatExprs : (FlatExprs * FlatList>) = FlatList.empty, FlatList.empty //------------------------------------------------------------------------- @@ -1090,8 +1087,8 @@ let AbstractExprInfoByVars (boundVars:Val list,boundTyVars) ivalue = match ivalue with // Check for escaping value. Revert to old info if possible | ValValue (VRefLocal v2,detail) when - (nonNil boundVars && List.exists (valEq v2) boundVars) || - (nonNil boundTyVars && + (not (List.isEmpty boundVars) && List.exists (valEq v2) boundVars) || + (not (List.isEmpty boundTyVars) && let ftyvs = freeInVal CollectTypars v2 List.exists (Zset.memberOf ftyvs.FreeTypars) boundTyVars) -> @@ -1104,9 +1101,9 @@ let AbstractExprInfoByVars (boundVars:Val list,boundTyVars) ivalue = // Check for escape in lambda | CurriedLambdaValue (_,_,_,expr,_) | ConstExprValue(_,expr) when - (let fvs = freeInExpr (if isNil boundTyVars then CollectLocals else CollectTyparsAndLocals) expr - (nonNil boundVars && List.exists (Zset.memberOf fvs.FreeLocals) boundVars) || - (nonNil boundTyVars && List.exists (Zset.memberOf fvs.FreeTyvars.FreeTypars) boundTyVars) || + (let fvs = freeInExpr (if List.isEmpty boundTyVars then CollectLocals else CollectTyparsAndLocals) expr + (not (List.isEmpty boundVars) && List.exists (Zset.memberOf fvs.FreeLocals) boundVars) || + (not (List.isEmpty boundTyVars) && List.exists (Zset.memberOf fvs.FreeTyvars.FreeTypars) boundTyVars) || (fvs.UsesMethodLocalConstructs )) -> // Trimming lambda @@ -1114,7 +1111,7 @@ let AbstractExprInfoByVars (boundVars:Val list,boundTyVars) ivalue = // Check for escape in generic constant | ConstValue(_,ty) when - (nonNil boundTyVars && + (not (List.isEmpty boundTyVars) && (let ftyvs = freeInType CollectTypars ty List.exists (Zset.memberOf ftyvs.FreeTypars) boundTyVars)) -> UnknownValue @@ -1213,7 +1210,7 @@ let IsTyFuncValRefExpr = function let rec IsSmallConstExpr x = match x with | Expr.Val (v,_,_m) -> not v.IsMutable - | Expr.App(fe,_,_tyargs,args,_) -> isNil(args) && not (IsTyFuncValRefExpr fe) && IsSmallConstExpr fe + | Expr.App(fe,_,_tyargs,args,_) -> List.isEmpty args && not (IsTyFuncValRefExpr fe) && IsSmallConstExpr fe | _ -> false let ValueOfExpr expr = @@ -1228,7 +1225,7 @@ let ValueOfExpr expr = let ValueIsUsedOrHasEffect cenv fvs (b:Binding,binfo) = let v = b.Var not (cenv.settings.EliminateUnusedBindings()) || - isSome v.MemberInfo || + Option.isSome v.MemberInfo || binfo.HasEffect || v.IsFixed || Zset.contains v (fvs()) @@ -1601,7 +1598,7 @@ let rec tryRewriteToSeqCombinators g (e: Expr) = // match --> match | Expr.Match (spBind,exprm,pt,targets,m,_ty) -> let targets = targets |> Array.map (fun (TTarget(vs,e,spTarget)) -> match tryRewriteToSeqCombinators g e with None -> None | Some e -> Some(TTarget(vs,e,spTarget))) - if targets |> Array.forall isSome then + if targets |> Array.forall Option.isSome then let targets = targets |> Array.map Option.get let ty = targets |> Array.pick (fun (TTarget(_,e,_)) -> Some(tyOfExpr g e)) Some (Expr.Match (spBind,exprm,pt,targets,m,ty)) @@ -2289,7 +2286,7 @@ and CanDevirtualizeApplication cenv v vref ty args = && not (IsUnionTypeWithNullAsTrueValue cenv.g (fst(StripToNominalTyconRef cenv ty)).Deref) // If we de-virtualize an operation on structs then we have to take the address of the object argument // Hence we have to actually have the object argument available to us, - && (not (isStructTy cenv.g ty) || nonNil args) + && (not (isStructTy cenv.g ty) || not (List.isEmpty args)) and TakeAddressOfStructArgumentIfNeeded cenv (vref:ValRef) ty args m = if vref.IsInstanceMember && isStructTy cenv.g ty then @@ -2309,7 +2306,7 @@ and TakeAddressOfStructArgumentIfNeeded cenv (vref:ValRef) ty args m = and DevirtualizeApplication cenv env (vref:ValRef) ty tyargs args m = let wrap,args = TakeAddressOfStructArgumentIfNeeded cenv vref ty args m - let transformedExpr = wrap (MakeApplicationAndBetaReduce cenv.g (exprForValRef m vref,vref.Type,(if isNil tyargs then [] else [tyargs]),args,m)) + let transformedExpr = wrap (MakeApplicationAndBetaReduce cenv.g (exprForValRef m vref,vref.Type,(if List.isEmpty tyargs then [] else [tyargs]),args,m)) OptimizeExpr cenv env transformedExpr @@ -2502,7 +2499,7 @@ and TryDevirtualizeApplication cenv env (f,tyargs,args,m) = // Don't fiddle with 'methodhandleof' calls - just remake the application | Expr.Val(vref,_,_),_,_ when valRefEq cenv.g vref cenv.g.methodhandleof_vref -> - Some( MakeApplicationAndBetaReduce cenv.g (exprForValRef m vref,vref.Type,(if isNil tyargs then [] else [tyargs]),args,m), + Some( MakeApplicationAndBetaReduce cenv.g (exprForValRef m vref,vref.Type,(if List.isEmpty tyargs then [] else [tyargs]),args,m), { TotalSize=1 FunctionSize=1 HasEffect=false @@ -2516,7 +2513,6 @@ and TryInlineApplication cenv env (_f0',finfo) (tyargs: TType list,args: Expr li // Considering inlining app match finfo.Info with | StripLambdaValue (lambdaId,arities,size,f2,f2ty) when - (// Considering inlining lambda cenv.optimizing && cenv.settings.InlineLambdas () && @@ -2524,7 +2520,7 @@ and TryInlineApplication cenv env (_f0',finfo) (tyargs: TType list,args: Expr li // Don't inline recursively! not (Zset.contains lambdaId env.dontInline) && (// Check the number of argument groups is enough to saturate the lambdas of the target. - (if tyargs |> List.filter (fun t -> match t with TType_measure _ -> false | _ -> true) |> isNil then 0 else 1) + args.Length = arities && + (if tyargs |> List.exists (fun t -> match t with TType_measure _ -> false | _ -> true) then 1 else 0) + args.Length = arities && (// Enough args (if size > cenv.settings.lambdaInlineThreshold + args.Length then // Not inlining lambda near, size too big @@ -2599,7 +2595,7 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = let shapes = match f0' with - | Expr.Val(vref,_,_) when isSome vref.ValReprInfo -> + | Expr.Val(vref,_,_) when Option.isSome vref.ValReprInfo -> let (ValReprInfo(_kinds,detupArgsL,_)) = Option.get vref.ValReprInfo let nargs = (args.Length) let nDetupArgsL = detupArgsL.Length @@ -2665,7 +2661,7 @@ and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = match e with | Expr.Lambda (lambdaId,_,_,_,_,m,_) | Expr.TyLambda(lambdaId,_,_,m,_) -> - let isTopLevel = isSome vspec && vspec.Value.IsCompiledAsTopLevel + let isTopLevel = Option.isSome vspec && vspec.Value.IsCompiledAsTopLevel let tps,ctorThisValOpt,baseValOpt,vsl,body,bodyty = IteratedAdjustArityOfLambda cenv.g cenv.amap topValInfo e let env = { env with functionVal = (match vspec with None -> None | Some v -> Some (v,topValInfo)) } let env = Option.foldBack (BindInternalValToUnknown cenv) ctorThisValOpt env @@ -2676,7 +2672,7 @@ and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = let body',bodyinfo = OptimizeExpr cenv env body let expr' = mkMemberLambdas m tps ctorThisValOpt baseValOpt vsl (body',bodyty) let arities = vsl.Length - let arities = if isNil tps then arities else 1+arities + let arities = if List.isEmpty tps then arities else 1+arities let bsize = bodyinfo.TotalSize /// Set the flag on the value indicating that direct calls can avoid a tailcall (which are expensive on .NET x86) @@ -2943,7 +2939,7 @@ and OptimizeBinding cenv isRec env (TBind(v,e,spBind)) = else env let repr',einfo = - let env = if v.IsCompilerGenerated && isSome env.latestBoundId then env else {env with latestBoundId=Some v.Id} + let env = if v.IsCompilerGenerated && Option.isSome env.latestBoundId then env else {env with latestBoundId=Some v.Id} let cenv = if v.InlineInfo = ValInline.PseudoVal then { cenv with optimizing=false} else cenv let e',einfo = OptimizeLambdas (Some v) cenv env (InferArityOfExprBinding cenv.g v e) e v.Type let size = localVarSize diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 90e00637fb0..408fe031c2f 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -102,7 +102,7 @@ type SubExprOfInput = let BindSubExprOfInput g amap gtps (PBind(v,tyscheme)) m (SubExpr(accessf,(ve2,v2))) = let e' = - if isNil gtps then + if List.isEmpty gtps then accessf [] ve2 else let tyargs = @@ -126,7 +126,7 @@ let BindSubExprOfInput g amap gtps (PBind(v,tyscheme)) m (SubExpr(accessf,(ve2,v v,mkGenericBindRhs g m [] tyscheme e' let GetSubExprOfInput g (gtps,tyargs,tinst) (SubExpr(accessf,(ve2,v2))) = - if isNil gtps then accessf [] ve2 else + if List.isEmpty gtps then accessf [] ve2 else accessf tinst (mkApps g ((ve2,v2.Type),[tyargs],[],v2.Range)) //--------------------------------------------------------------------------- @@ -505,7 +505,7 @@ let rec BuildSwitch inpExprOpt g expr edges dflt m = // 'isinst' tests where we have stored the result of the 'isinst' in a variable // In this case the 'expr' already holds the result of the 'isinst' test. - | (TCase(Test.IsInst _,success)):: edges, dflt when isSome inpExprOpt -> + | (TCase(Test.IsInst _,success)):: edges, dflt when Option.isSome inpExprOpt -> TDSwitch(expr,[TCase(Test.IsNull,BuildSwitch None g expr edges dflt m)],Some success,m) // isnull and isinst tests @@ -519,7 +519,7 @@ let rec BuildSwitch inpExprOpt g expr edges dflt m = | [TCase(ListEmptyDiscrim g tinst, emptyCase)], Some consCase | [TCase(ListEmptyDiscrim g _, emptyCase); TCase(ListConsDiscrim g tinst, consCase)], None | [TCase(ListConsDiscrim g tinst, consCase); TCase(ListEmptyDiscrim g _, emptyCase)], None - when isSome inpExprOpt -> + when Option.isSome inpExprOpt -> TDSwitch(expr, [TCase(Test.IsNull, emptyCase)], Some consCase, m) #endif @@ -792,7 +792,7 @@ let CompilePatternBasic // For each case, recursively compile the residue decision trees that result if that case successfully matches let simulSetOfCases, _ = CompileSimultaneousSet frontiers path refuted subexpr simulSetOfEdgeDiscrims inpExprOpt - assert (nonNil(simulSetOfCases)) + assert (not (List.isEmpty simulSetOfCases)) // Work out what the default/fall-through tree looks like, is any // Check if match is complete, if so optimize the default case away. @@ -873,7 +873,7 @@ let CompilePatternBasic | EdgeDiscrim(_i',(Test.IsInst (_srcty,tgty)),m) :: _rest (* check we can use a simple 'isinst' instruction *) - when canUseTypeTestFast g tgty && isNil topgtvs -> + when canUseTypeTestFast g tgty && List.isEmpty topgtvs -> let v,vexp = mkCompGenLocal m "typeTestResult" tgty if topv.IsMemberOrModuleBinding then @@ -884,7 +884,7 @@ let CompilePatternBasic // Any match on a struct union must take the address of its input | EdgeDiscrim(_i',(Test.UnionCase (ucref, _)),_) :: _rest - when (isNil topgtvs && ucref.Tycon.IsStructRecordOrUnionTycon) -> + when List.isEmpty topgtvs && ucref.Tycon.IsStructRecordOrUnionTycon -> let argexp = GetSubExprOfInput subexpr let vOpt,addrexp = mkExprAddrOfExprAux g true false NeverMutates argexp None matchm @@ -903,7 +903,7 @@ let CompilePatternBasic | [EdgeDiscrim(_, ListConsDiscrim g tinst, m)] | [EdgeDiscrim(_, ListEmptyDiscrim g tinst, m)] (* check we can use a simple 'isinst' instruction *) - when isNil topgtvs -> + when List.isEmpty topgtvs -> let ucaseTy = (mkProvenUnionCaseTy g.cons_ucref tinst) let v,vexp = mkCompGenLocal m "unionTestResult" ucaseTy @@ -917,7 +917,7 @@ let CompilePatternBasic // Active pattern matches: create a variable to hold the results of executing the active pattern. | (EdgeDiscrim(_,(Test.ActivePatternCase(pexp,resTys,_,_,apinfo)),m) :: _) -> - if nonNil topgtvs then error(InternalError("Unexpected generalized type variables when compiling an active pattern",m)) + if not (List.isEmpty topgtvs) then error(InternalError("Unexpected generalized type variables when compiling an active pattern",m)) let rty = apinfo.ResultType g m resTys let v,vexp = mkCompGenLocal m "activePatternResult" rty if topv.IsMemberOrModuleBinding then @@ -954,7 +954,7 @@ let CompilePatternBasic #if OPTIMIZE_LIST_MATCHING isNone inpExprOpt && #endif - (isNil topgtvs && + (List.isEmpty topgtvs && not topv.IsMemberOrModuleBinding && not ucref.Tycon.IsStructRecordOrUnionTycon && ucref.UnionCase.RecdFields.Length >= 1 && diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index 1bb13f613ad..9926771ffce 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -149,7 +149,7 @@ let BindTypar env (tp:Typar) = let BindTypars g env (tps:Typar list) = let tps = NormalizeDeclaredTyparsForEquiRecursiveInference g tps - if isNil tps then env else + if List.isEmpty tps then env else // Here we mutate to provide better names for generalized type parameters let nms = PrettyTypes.PrettyTyparNames (fun _ -> true) env.boundTyparNames tps (tps,nms) ||> List.iter2 (fun tp nm -> @@ -951,13 +951,13 @@ and CheckLambdas isTop (memInfo: ValMemberInfo option) cenv env inlined topValIn | Some membInfo -> testHookMemberBody membInfo body // Check escapes in the body. Allow access to protected things within members. - let freesOpt = CheckEscapes cenv (isSome memInfo) m syntacticArgs body + let freesOpt = CheckEscapes cenv (Option.isSome memInfo) m syntacticArgs body // no reraise under lambda expression CheckNoReraise cenv freesOpt body // Check the body of the lambda - if (nonNil tps || nonNil vsl) && isTop && not cenv.g.compilingFslib && isByrefTy cenv.g bodyty then + if (not (List.isEmpty tps) || not (List.isEmpty vsl)) && isTop && not cenv.g.compilingFslib && isByrefTy cenv.g bodyty then // allow byref to occur as return position for byref-typed top level function or method CheckExprPermitByrefReturn cenv env body else @@ -965,7 +965,7 @@ and CheckLambdas isTop (memInfo: ValMemberInfo option) cenv env inlined topValIn // Check byref return types if cenv.reportErrors then - if (not inlined && (isNil tps && isNil vsl)) || not isTop then + if (not inlined && (List.isEmpty tps && List.isEmpty vsl)) || not isTop then CheckForByrefLikeType cenv env bodyty (fun () -> errorR(Error(FSComp.SR.chkFirstClassFuncNoByref(), m))) @@ -1091,7 +1091,7 @@ and CheckAttribArgExpr cenv env expr = errorR (Error (FSComp.SR.chkInvalidCustAttrVal(), expr.Range)) and CheckAttribs cenv env (attribs: Attribs) = - if isNil attribs then () else + if List.isEmpty attribs then () else let tcrefs = [ for (Attrib(tcref,_,_,_,_,_,m)) in attribs -> (tcref,m) ] // Check for violations of allowMultiple = false @@ -1133,7 +1133,7 @@ and AdjustAccess isHidden (cpath: unit -> CompilationPath) access = access and CheckBinding cenv env alwaysCheckNoReraise (TBind(v,bindRhs,_) as bind) = - let isTop = isSome bind.Var.ValReprInfo + let isTop = Option.isSome bind.Var.ValReprInfo //printfn "visiting %s..." v.DisplayName // Check that active patterns don't have free type variables in their result @@ -1169,7 +1169,7 @@ and CheckBinding cenv env alwaysCheckNoReraise (TBind(v,bindRhs,_) as bind) = CheckForByrefLikeType cenv env v.Type (fun () -> errorR(Error(FSComp.SR.chkNoByrefAsTopValue(),v.Range))) | _ -> () - if isSome v.PublicPath then + if Option.isSome v.PublicPath then if // Don't support implicit [] on generated members, except the implicit members // for 'let' bound functions in classes. @@ -1206,7 +1206,7 @@ and CheckBinding cenv env alwaysCheckNoReraise (TBind(v,bindRhs,_) as bind) = let qscope = QuotationTranslator.QuotationGenerationScope.Create (cenv.g,cenv.amap,cenv.viewCcu, QuotationTranslator.IsReflectedDefinition.Yes) QuotationTranslator.ConvExprPublic qscope env taue |> ignore let _,_,argExprs = qscope.Close() - if nonNil argExprs then + if not (List.isEmpty argExprs) then errorR(Error(FSComp.SR.chkReflectedDefCantSplice(), v.Range)) QuotationTranslator.ConvMethodBase qscope env (v.CompiledName, v) |> ignore with diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index 1037acc09ea..fbae5b3746d 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -345,7 +345,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. // Simple applications | Expr.App(f,_fty,tyargs,args,m) -> - if nonNil tyargs then wfail(Error(FSComp.SR.crefQuotationsCantContainGenericExprs(), m)) + if not (List.isEmpty tyargs) then wfail(Error(FSComp.SR.crefQuotationsCantContainGenericExprs(), m)) List.fold (fun fR arg -> QP.mkApp (fR,ConvExpr cenv env arg)) (ConvExpr cenv env f) args // REVIEW: what is the quotation view of literals accessing enumerations? Currently they show up as integers. @@ -729,7 +729,7 @@ and private ConvValRefCore holeOk cenv env m (vref:ValRef) tyargs = let e = env.substVals.[v] ConvExpr cenv env e elif env.vs.ContainsVal v then - if nonNil tyargs then wfail(InternalError("ignoring generic application of local quoted variable",m)) + if not (List.isEmpty tyargs) then wfail(InternalError("ignoring generic application of local quoted variable",m)) QP.mkVar(env.vs.[v]) elif v.BaseOrThisInfo = CtorThisVal && cenv.isReflectedDefinition = IsReflectedDefinition.Yes then QP.mkThisVar(ConvType cenv env m v.Type) diff --git a/src/fsharp/SignatureConformance.fs b/src/fsharp/SignatureConformance.fs index 3d8a863faa5..55a573d1e9a 100644 --- a/src/fsharp/SignatureConformance.fs +++ b/src/fsharp/SignatureConformance.fs @@ -626,7 +626,7 @@ let rec CheckNamesOfModuleOrNamespaceContents denv (implModRef:ModuleOrNamespace let fx = fxs.Head errorR(RequiredButNotSpecified(denv,implModRef,"value",(fun os -> // In the case of missing members show the full required enclosing type and signature - if isSome fx.MemberInfo then + if Option.isSome fx.MemberInfo then NicePrint.outputQualifiedValOrMember denv os fx else Printf.bprintf os "%s" fx.DisplayName),m)); false) diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 83a80cb4152..8e5ddb25045 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -954,7 +954,7 @@ let unionCaseRefOrder = let mkFunTy d r = TType_fun (d,r) let (-->) d r = mkFunTy d r let mkForallTy d r = TType_forall (d,r) -let tryMkForallTy d r = if isNil d then r else mkForallTy d r +let tryMkForallTy d r = if List.isEmpty d then r else mkForallTy d r let (+->) d r = tryMkForallTy d r let mkIteratedFunTy dl r = List.foldBack (-->) dl r @@ -1376,7 +1376,7 @@ let applyTys g functy (tyargs,argtys) = let formalApplyTys g functy (tyargs,args) = reduceIteratedFunTy g - (if isNil tyargs then functy else snd (destForallTy g functy)) + (if List.isEmpty tyargs then functy else snd (destForallTy g functy)) args let rec stripFunTyN g n ty = @@ -1411,7 +1411,7 @@ let GetTopTauTypeInFSharpForm g (curriedArgInfos: ArgReprInfo list list) tau m = argtysl,rty let destTopForallTy g (ValReprInfo (ntps,_,_)) ty = - let tps,tau = (if isNil ntps then [],ty else tryDestForallTy g ty) + let tps,tau = (if List.isEmpty ntps then [],ty else tryDestForallTy g ty) #if CHECKED if tps.Length <> kinds.Length then failwith (sprintf "destTopForallTy: internal error, #tps = %d, #ntps = %d" (List.length tps) ntps); #endif @@ -1426,7 +1426,7 @@ let GetTopValTypeInFSharpForm g (ValReprInfo(_,argInfos,retInfo) as topValInfo) let IsCompiledAsStaticProperty g (v:Val) = - (isSome v.ValReprInfo && + (Option.isSome v.ValReprInfo && match GetTopValTypeInFSharpForm g v.ValReprInfo.Value v.Type v.Range with | [],[], _,_ when not v.IsMember -> true | _ -> false) @@ -1650,7 +1650,7 @@ let actualReturnTyOfSlotSig parentTyInst methTyInst (TSlotSig(_,_,parentFormalTy Option.map (instType (parentTyInst @ methTyInst)) formalRetTy let slotSigHasVoidReturnTy (TSlotSig(_,_,_,_,_,formalRetTy)) = - isNone formalRetTy + Option.isNone formalRetTy let returnTyOfMethod g (TObjExprMethod((TSlotSig(_,parentTy,_,_,_,_) as ss),_,methFormalTypars,_,_,_)) = let tinst = argsOfAppTy g parentTy @@ -2547,7 +2547,7 @@ let trimPathByDisplayEnv denv path = else None match List.tryPick findOpenedNamespace (denv.openTopPathsSorted.Force()) with | Some s -> s - | None -> if isNil path then "" else textOfPath path + "." + | None -> if List.isEmpty path then "" else textOfPath path + "." let superOfTycon g (tycon:Tycon) = @@ -3163,14 +3163,14 @@ module DebugPrint = begin |> List.filter (fun v -> not v.IsDispatchSlot) |> List.filter (fun v -> not v.Deref.IsClassConstructor) // Don't print individual methods forming interface implementations - these are currently never exported - |> List.filter (fun v -> isNil (Option.get v.MemberInfo).ImplementedSlotSigs) + |> List.filter (fun v -> List.isEmpty (Option.get v.MemberInfo).ImplementedSlotSigs) let iimpls = match tycon.TypeReprInfo with | TFSharpObjectRepr r when (match r.fsobjmodel_kind with TTyconInterface -> true | _ -> false) -> [] | _ -> tycon.ImmediateInterfacesOfFSharpTycon let iimpls = iimpls |> List.filter (fun (_,compgen,_) -> not compgen) // if TTyconInterface, the iimpls should be printed as inheritted interfaces - if (isNil adhoc && isNil iimpls) + if List.isEmpty adhoc && List.isEmpty iimpls then emptyL else let iimplsLs = iimpls |> List.map (fun (ty,_,_) -> wordL "interface" --- typeL ty) @@ -3224,7 +3224,7 @@ module DebugPrint = begin |> List.map (fun vref -> vspecAtBindL vref.Deref) let vals = tycon.TrueFieldsAsList |> List.map (fun f -> (if f.IsStatic then wordL "static" else emptyL) ^^ wordL "val" ^^ layoutRecdField f) let alldecls = inherits @ vsprs @ vals - let emptyMeasure = match tycon.TypeOrMeasureKind with TyparKind.Measure -> isNil alldecls | _ -> false + let emptyMeasure = match tycon.TypeOrMeasureKind with TyparKind.Measure -> List.isEmpty alldecls | _ -> false if emptyMeasure then emptyL else (wordL start @@-- aboveListL alldecls) @@ wordL "end" | TUnionRepr _ -> tycon.UnionCasesAsList |> layoutUnionCases |> aboveListL | TAsmRepr _ -> wordL "(# ... #)" @@ -3934,7 +3934,7 @@ let accFreevarsInTyconCache = CheckCachability("accFreevarsInTycon", (fun opts let accFreeVarsInTy opts ty fvs = accFreeVarsInTy_cache.Apply(opts,ty,fvs) let accFreeVarsInTys opts tys fvs = - if isNil tys then fvs else accFreeVarsInTys_cache.Apply(opts,tys,fvs) + if List.isEmpty tys then fvs else accFreeVarsInTys_cache.Apply(opts,tys,fvs) let accFreevarsInTycon opts (tcr:TyconRef) acc = match tcr.IsLocalRef with | true -> accFreevarsInTyconCache.Apply(opts,tcr,acc) @@ -3943,7 +3943,7 @@ let accFreevarsInVal opts v fvs = accFreevarsInValCache.Apply(opts,v,fvs) #else let accFreeVarsInTy opts ty acc = accFreeTyvars opts accFreeInType ty acc -let accFreeVarsInTys opts tys acc = if isNil tys then acc else accFreeTyvars opts accFreeInTypes tys acc +let accFreeVarsInTys opts tys acc = if List.isEmpty tys then acc else accFreeTyvars opts accFreeInTypes tys acc let accFreevarsInTycon opts tcref acc = accFreeTyvars opts accFreeTycon tcref acc let accFreevarsInVal opts v acc = accFreeTyvars opts accFreeInVal v acc #endif @@ -4263,8 +4263,8 @@ let freeInModuleOrNamespace opts mdef = accFreeInModuleOrNamespace opts mdef emp let rec stripLambda (e,ty) = match e with | Expr.Lambda (_,ctorThisValOpt,baseValOpt,v,b,_,rty) -> - if isSome ctorThisValOpt then errorR(InternalError("skipping ctorThisValOpt", e.Range)); - if isSome baseValOpt then errorR(InternalError("skipping baseValOpt", e.Range)); + if Option.isSome ctorThisValOpt then errorR(InternalError("skipping ctorThisValOpt", e.Range)); + if Option.isSome baseValOpt then errorR(InternalError("skipping baseValOpt", e.Range)); let (vs',b',rty') = stripLambda (b,rty) (v :: vs', b', rty') | _ -> ([],e,ty) @@ -4273,8 +4273,8 @@ let rec stripLambdaN n e = assert (n >= 0) match e with | Expr.Lambda (_,ctorThisValOpt,baseValOpt,v,body,_,_) when n > 0 -> - if isSome ctorThisValOpt then errorR(InternalError("skipping ctorThisValOpt", e.Range)); - if isSome baseValOpt then errorR(InternalError("skipping baseValOpt", e.Range)); + if Option.isSome ctorThisValOpt then errorR(InternalError("skipping ctorThisValOpt", e.Range)); + if Option.isSome baseValOpt then errorR(InternalError("skipping baseValOpt", e.Range)); let (vs,body',remaining) = stripLambdaN (n-1) body (v :: vs, body', remaining) | _ -> ([],e,n) @@ -4815,7 +4815,7 @@ and remapTyconExnInfo g tmenv inp = and remapMemberInfo g m topValInfo ty ty' tmenv x = // The slotsig in the ImplementedSlotSigs is w.r.t. the type variables in the value's type. // REVIEW: this is a bit gross. It would be nice if the slotsig was standalone - assert (isSome topValInfo); + assert (Option.isSome topValInfo) let tpsOrig,_,_,_ = GetMemberTypeInFSharpForm g x.MemberFlags (Option.get topValInfo) ty m let tps,_,_,_ = GetMemberTypeInFSharpForm g x.MemberFlags (Option.get topValInfo) ty' m let renaming,_ = mkTyparToTyparRenaming tpsOrig tps @@ -5100,7 +5100,7 @@ let isExnFieldMutable ecref n = (recdFieldOfExnDefRefByIdx ecref n).IsMutable let useGenuineField (tycon:Tycon) (f:RecdField) = - isSome f.LiteralValue || tycon.IsEnumTycon || f.rfield_secret || (not f.IsStatic && f.rfield_mutable && not tycon.IsRecordTycon) + Option.isSome f.LiteralValue || tycon.IsEnumTycon || f.rfield_secret || (not f.IsStatic && f.rfield_mutable && not tycon.IsRecordTycon) let ComputeFieldName tycon f = if useGenuineField tycon f then f.rfield_id.idText @@ -5215,7 +5215,7 @@ let rec mkExprApplAux g f fty argsl m = match f with | Expr.App(f',fty',tyargs,pargs,m2) when - (isNil pargs || + (List.isEmpty pargs || (match stripExpr f' with | Expr.Val(v,_,_) -> match v.ValReprInfo with @@ -5298,7 +5298,7 @@ let rec decisionTreeHasNonTrivialBindings tree = edges |> List.exists (fun c -> decisionTreeHasNonTrivialBindings c.CaseTree) || dflt |> Option.exists decisionTreeHasNonTrivialBindings | TDSuccess _ -> false - | TDBind (_,t) -> isNone (targetOfSuccessDecisionTree t) + | TDBind (_,t) -> Option.isNone (targetOfSuccessDecisionTree t) // If a target has assignments and can only be reached through one // branch (i.e. is "linear"), then transfer the assignments to the r.h.s. to be a "let". @@ -5315,7 +5315,7 @@ let foldLinearBindingTargetsOfMatch tree (targets: _[]) = let rec accumulateTipsOfDecisionTree accBinds tree = match tree with | TDSwitch (_,edges,dflt,_) -> - assert (isNil accBinds) // No switches under bindings + assert (List.isEmpty accBinds) // No switches under bindings for edge in edges do accumulateTipsOfDecisionTree accBinds edge.CaseTree match dflt with | None -> () @@ -6173,7 +6173,7 @@ let mkThrow m ty e = mkAsmExpr ([ IL.I_throw ],[], [e],[ty],m) let destThrow = function | Expr.Op (TOp.ILAsm([IL.I_throw],[ty2]),[],[e],m) -> Some (m,ty2,e) | _ -> None -let isThrow x = isSome (destThrow x) +let isThrow x = Option.isSome (destThrow x) // rethrow - parsed as library call - internally represented as op form. let mkReraiseLibCall g ty m = let ve,vt = typedExprForIntrinsic g m g.reraise_info in Expr.App(ve,vt,[ty],[mkUnit g m],m) @@ -6691,7 +6691,7 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex let exprForAllArgs = - if isNil argTysWithNiceNames then + if List.isEmpty argTysWithNiceNames then mkInvisibleLet appm cloVar exprWithActualTy exprForOtherArgs else let lambdaBuilders,binderBuilders,inpsAsArgs = @@ -6784,7 +6784,7 @@ let NormalizeAndAdjustPossibleSubsumptionExprs g inputExpr = // polymorphic things bound in complex matches at top level require eta expansion of the // type function to ensure the r.h.s. of the binding is indeed a type function let etaExpandTypeLambda g m tps (tm,ty) = - if isNil tps then tm else mkTypeLambda m tps (mkApps g ((tm,ty),[(List.map mkTyparTy tps)],[],m),ty) + if List.isEmpty tps then tm else mkTypeLambda m tps (mkApps g ((tm,ty),[(List.map mkTyparTy tps)],[],m),ty) let AdjustValToTopVal (tmp:Val) parent valData = tmp.SetValReprInfo (Some valData); @@ -6925,7 +6925,7 @@ and tyargsEnc g (gtpsType,gtpsMethod) args = | _ -> angleEnc (commaEncs (List.map (typeEnc g (gtpsType,gtpsMethod)) args)) let XmlDocArgsEnc g (gtpsType,gtpsMethod) argTs = - if isNil argTs then "" + if List.isEmpty argTs then "" else "(" + String.concat "," (List.map (typeEnc g (gtpsType,gtpsMethod)) argTs) + ")" let buildAccessPath (cp : CompilationPath option) = @@ -6967,7 +6967,7 @@ let XmlDocSigOfVal g path (v:Val) = let tps,argInfos,_,_ = GetTopValTypeInCompiledForm g w v.Type v.Range let name = v.CompiledName let prefix = - if w.NumCurriedArgs = 0 && isNil tps then "P:" + if w.NumCurriedArgs = 0 && List.isEmpty tps then "P:" else "M:" [],tps,argInfos,prefix,path,name let argTs = argInfos |> List.concat |> List.map fst @@ -7171,7 +7171,7 @@ let MemberIsCompiledAsInstance g parent isExtensionMember (membInfo:ValMemberInf if isExtensionMember then false // Anything implementing a dispatch slot is compiled as an instance member elif membInfo.MemberFlags.IsOverrideOrExplicitImpl then true - elif nonNil membInfo.ImplementedSlotSigs then true + elif not (List.isEmpty membInfo.ImplementedSlotSigs) then true else // Otherwise check attributes to see if there is an explicit instance or explicit static flag let explicitInstance,explicitStatic = diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index b6f149a8eb3..2243b552c9f 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -691,7 +691,7 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa let makeIntrinsicValRef (enclosingEntity, logicalName, memberParentName, compiledNameOpt, typars, (argtys,rty)) = let ty = tryMkForallTy typars (mkIteratedFunTy (List.map mkSmallRefTupledTy argtys) rty) - let isMember = isSome memberParentName + let isMember = Option.isSome memberParentName let argCount = if isMember then List.sum (List.map List.length argtys) else 0 let linkageType = if isMember then Some ty else None let key = ValLinkageFullKey({ MemberParentMangledName=memberParentName; MemberIsOverride=false; LogicalName=logicalName; TotalArgCount= argCount },linkageType) diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 38063e54b6d..af876d4f5a1 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -646,7 +646,7 @@ let TryStripPrefixPath (g:TcGlobals) (enclosingNamespacePath: Ident list) = | _ -> None let ImplicitlyOpenOwnNamespace tcSink g amap scopem enclosingNamespacePath env = - if isNil enclosingNamespacePath then + if List.isEmpty enclosingNamespacePath then env else // For F# interactive, skip "FSI_0002" prefixes when determining the path to open implicitly @@ -939,10 +939,10 @@ let TranslateTopArgSynInfo isArg m tcAttributes (SynArgInfo(attrs,isOpt,nm)) = else [] - if isArg && nonNil attrs && isNone nm then + if isArg && not (List.isEmpty attrs) && Option.isNone nm then errorR(Error(FSComp.SR.tcParameterRequiresName(),m)) - if not isArg && isSome nm then + if not isArg && Option.isSome nm then errorR(Error(FSComp.SR.tcReturnValuesCannotHaveNames(),m)) // Call the attribute checking function @@ -998,7 +998,7 @@ let MakeMemberDataAndMangledNameForMemberVal(g,tcref,isExtrinsic,attrs,optImplSl // properly when we check the allImplemented implementation checks at the end of the inference scope. ImplementedSlotSigs=optImplSlotTys |> List.map (fun ity -> TSlotSig(logicalName,ity,[],[],[],None)) } let isInstance = MemberIsCompiledAsInstance g tcref isExtrinsic memberInfo attrs - if (memberFlags.IsDispatchSlot || nonNil optIntfSlotTys) then + if (memberFlags.IsDispatchSlot || not (List.isEmpty optIntfSlotTys)) then if not isInstance then errorR(VirtualAugmentationOnNullValuedType(id.idRange)) elif not memberFlags.IsOverrideOrExplicitImpl && memberFlags.IsInstance then @@ -1271,7 +1271,7 @@ let PublishValueDefnPrim cenv env (vspec:Val) = let PublishValueDefn cenv env declKind (vspec:Val) = if (declKind = ModuleOrMemberBinding) && ((GetCurrAccumulatedModuleOrNamespaceType env).ModuleOrNamespaceKind = Namespace) && - (isNone vspec.MemberInfo) then + (Option.isNone vspec.MemberInfo) then errorR(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(),vspec.Range)) if (declKind = ExtrinsicExtensionBinding) && @@ -1301,9 +1301,9 @@ let PublishValueDefn cenv env declKind (vspec:Val) = | _ -> () let CombineVisibilityAttribs vis1 vis2 m = - if isSome vis1 && isSome vis2 then + if Option.isSome vis1 && Option.isSome vis2 then errorR(Error(FSComp.SR.tcMultipleVisibilityAttributes(),m)) - if isSome vis1 then vis1 else vis2 + if Option.isSome vis1 then vis1 else vis2 let ComputeAccessAndCompPath env declKindOpt m vis actualParent = let accessPath = env.eAccessPath @@ -1312,7 +1312,7 @@ let ComputeAccessAndCompPath env declKindOpt m vis actualParent = | None -> true | Some declKind -> DeclKind.IsAccessModifierPermitted declKind - if isSome vis && not accessModPermitted then + if Option.isSome vis && not accessModPermitted then errorR(Error(FSComp.SR.tcMultipleVisibilityAttributesWithLet(),m)) let vis = match vis with @@ -1330,9 +1330,7 @@ let ComputeAccessAndCompPath env declKindOpt m vis actualParent = let cpath = (if accessModPermitted then Some cpath else None) vis,cpath -let CheckForAbnormalOperatorNames cenv (idRange:range) opName isMember = - - +let CheckForAbnormalOperatorNames cenv (idRange:range) opName isMember = if (idRange.EndColumn - idRange.StartColumn <= 5) && not cenv.g.compilingFslib then match opName, isMember with @@ -1392,12 +1390,12 @@ let MakeAndPublishVal cenv env (altActualParent,inSig,declKind,vrec,(ValScheme(i // CompiledName not allowed on virtual/abstract/override members let compiledNameAttrib = TryFindFSharpStringAttribute cenv.g cenv.g.attrib_CompiledNameAttribute attrs - if isSome compiledNameAttrib && ( ( match memberInfoOpt with - | Some (ValMemberInfoTransient(memberInfo,_,_)) -> - memberInfo.MemberFlags.IsDispatchSlot - || memberInfo.MemberFlags.IsOverrideOrExplicitImpl - | None -> false) - || (match altActualParent with ParentNone -> true | _ -> false)) then + if Option.isSome compiledNameAttrib && ( ( match memberInfoOpt with + | Some (ValMemberInfoTransient(memberInfo,_,_)) -> + memberInfo.MemberFlags.IsDispatchSlot + || memberInfo.MemberFlags.IsOverrideOrExplicitImpl + | None -> false) + || (match altActualParent with ParentNone -> true | _ -> false)) then errorR(Error(FSComp.SR.tcCompiledNameAttributeMisused(),m)) let compiledNameIsOnProp = @@ -1440,7 +1438,7 @@ let MakeAndPublishVal cenv env (altActualParent,inSig,declKind,vrec,(ValScheme(i (hasDeclaredTypars || inSig),isGeneratedEventVal,konst,actualParent) - CheckForAbnormalOperatorNames cenv id.idRange (DecompileOpName vspec.CoreDisplayName) (isSome memberInfoOpt) + CheckForAbnormalOperatorNames cenv id.idRange (DecompileOpName vspec.CoreDisplayName) (Option.isSome memberInfoOpt) PublishValueDefn cenv env declKind vspec @@ -1518,7 +1516,7 @@ let AdjustAndForgetUsesOfRecValue cenv (vrefTgt: ValRef) (valScheme : ValScheme) let (TypeScheme(generalizedTypars,_)) = valScheme.TypeScheme let fty = GeneralizedTypeForTypeScheme valScheme.TypeScheme let lvrefTgt = vrefTgt.Deref - if nonNil generalizedTypars then + if not (List.isEmpty generalizedTypars) then // Find all the uses of this recursive binding and use mutation to adjust the expressions // at those points in order to record the inferred type parameters. let recUses = cenv.recUses.Find lvrefTgt @@ -1636,7 +1634,7 @@ let GeneralizeVal cenv denv enclosingDeclaredTypars generalizedTyparsForThisBind List.forall2 typarEq generalizedTypars generalizedTyparsLookingThroughTypeAbbreviations) then warning(Error(FSComp.SR.tcTypeParametersInferredAreNotStable(),m)) - let hasDeclaredTypars = nonNil declaredTypars + let hasDeclaredTypars = not (List.isEmpty declaredTypars) // This is just about the only place we form a TypeScheme let tyScheme = TypeScheme(generalizedTypars, ty) PrelimValScheme2(id,tyScheme,partialValReprInfo,memberInfoOpt,isMutable,inlineFlag,baseOrThis,argAttribs,vis,compgen,hasDeclaredTypars) @@ -1832,7 +1830,7 @@ let FreshenTyconRef m rigid (tcref:TyconRef) declaredTyconTypars = let FreshenPossibleForallTy g m rigid ty = let tpsorig,tau = tryDestForallTy g ty - if isNil tpsorig then [],[],tau + if List.isEmpty tpsorig then [],[],tau else // tps may be have been equated to other tps in equi-recursive type inference and units-of-measure type inference. Normalize them here let tpsorig = NormalizeDeclaredTyparsForEquiRecursiveInference g tpsorig @@ -1856,8 +1854,8 @@ let FreshenAbstractSlot g amap m synTyparDecls absMethInfo = match synTyparDecls with | SynValTyparDecls(synTypars,infer,_) -> - if nonNil synTypars && infer then errorR(Error(FSComp.SR.tcOverridingMethodRequiresAllOrNoTypeParameters(),m)) - isNil synTypars + if not (List.isEmpty synTypars) && infer then errorR(Error(FSComp.SR.tcOverridingMethodRequiresAllOrNoTypeParameters(),m)) + List.isEmpty synTypars let (CompiledSig (argtys,retTy,fmtps,_)) = CompiledSigOfMeth g amap m absMethInfo @@ -1880,7 +1878,7 @@ let FreshenAbstractSlot g amap m synTyparDecls absMethInfo = let BuildFieldMap cenv env isPartial ty flds m = let ad = env.eAccessRights - if isNil flds then invalidArg "flds" "BuildFieldMap" + if List.isEmpty flds then invalidArg "flds" "BuildFieldMap" let frefSets = let allFields = flds |> List.map (fun ((_,ident),_) -> ident) @@ -2058,7 +2056,7 @@ module GeneralizationHelpers = match ctorInfo with | RecdExpr -> not (isRecdOrUnionOrStructTyconRefAllocObservable g tcref) | RecdExprIsObjInit -> false - | TOp.Array -> isNil args + | TOp.Array -> List.isEmpty args | TOp.ExnConstr ec -> not (isExnAllocObservable ec) | TOp.ILAsm([],_) -> true @@ -2113,7 +2111,7 @@ module GeneralizationHelpers = genConstrainedTyparFlag = CanGeneralizeConstrainedTypars || tp.Constraints.IsEmpty) - if isNil ungeneralizableTypars1 && isNil ungeneralizableTypars2 && isNil ungeneralizableTypars3 then + if List.isEmpty ungeneralizableTypars1 && List.isEmpty ungeneralizableTypars2 && List.isEmpty ungeneralizableTypars3 then generalizedTypars, freeInEnv else let freeInEnv = @@ -2163,7 +2161,7 @@ module GeneralizationHelpers = // A condensation typar may not a user-generated type variable nor has it been unified with any user type variable (tp.DynamicReq = TyparDynamicReq.No) && // A condensation typar must have a single constraint "'a :> A" - (isSome (relevantUniqueSubtypeConstraint tp)) && + (Option.isSome (relevantUniqueSubtypeConstraint tp)) && // This is type variable is not used on the r.h.s. of the type not (ListSet.contains typarEq tp returnTypeFreeTypars) && // A condensation typar can't be used in the constraints of any candidate condensation typars @@ -2247,10 +2245,10 @@ module GeneralizationHelpers = match memberFlags.MemberKind with // can't infer extra polymorphism for properties | MemberKind.PropertyGet | MemberKind.PropertySet -> - if nonNil declaredTypars then + if not (List.isEmpty declaredTypars) then errorR(Error(FSComp.SR.tcPropertyRequiresExplicitTypeParameters(),m)) | MemberKind.Constructor -> - if nonNil declaredTypars then + if not (List.isEmpty declaredTypars) then errorR(Error(FSComp.SR.tcConstructorCannotHaveTypeParameters(),m)) | _ -> () @@ -2378,7 +2376,7 @@ module BindingNormalization = let private MakeNormalizedStaticOrValBinding cenv isObjExprBinding id vis typars args rhsExpr valSynData = let (SynValData(memberFlagsOpt,_,_)) = valSynData - NormalizedBindingPat(mkSynPatVar vis id, PushMultiplePatternsToRhs cenv ((isObjExprBinding = ObjExprBinding) || isSome memberFlagsOpt) args rhsExpr,valSynData,typars) + NormalizedBindingPat(mkSynPatVar vis id, PushMultiplePatternsToRhs cenv ((isObjExprBinding = ObjExprBinding) || Option.isSome memberFlagsOpt) args rhsExpr,valSynData,typars) let private MakeNormalizedInstanceMemberBinding cenv thisId memberId toolId vis m typars args rhsExpr valSynData = NormalizedBindingPat(SynPat.InstanceMember(thisId,memberId,toolId,vis,m), PushMultiplePatternsToRhs cenv true args rhsExpr,valSynData,typars) @@ -2612,7 +2610,7 @@ let FreshenObjectArgType cenv m rigid tcref isExtrinsic declaredTyconTypars = // scope of "A". let TcValEarlyGeneralizationConsistencyCheck cenv (env:TcEnv) (v:Val, vrec, tinst, vty, tau, m) = match vrec with - | ValInRecScope isComplete when isComplete && nonNil tinst -> + | ValInRecScope isComplete when isComplete && not (List.isEmpty tinst) -> //printfn "pushing post-inference check for '%s', vty = '%s'" v.DisplayName (DebugPrint.showType vty) cenv.postInferenceChecks.Add (fun () -> //printfn "running post-inference check for '%s'" v.DisplayName @@ -2620,7 +2618,7 @@ let TcValEarlyGeneralizationConsistencyCheck cenv (env:TcEnv) (v:Val, vrec, tins //printfn "vty = '%s'" (DebugPrint.showType vty) let tpsorig,tau2 = tryDestForallTy cenv.g vty //printfn "tau2 = '%s'" (DebugPrint.showType tau2) - if nonNil tpsorig then + if not (List.isEmpty tpsorig) then let tpsorig = NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g tpsorig let tau3 = instType (mkTyparInst tpsorig tinst) tau2 //printfn "tau3 = '%s'" (DebugPrint.showType tau3) @@ -2784,7 +2782,7 @@ type ApplicableExpr = let combinedExpr = match fe with | Expr.App(e1,e1ty,tyargs1,args1,e1m) when - (not first || isNil args1) && + (not first || List.isEmpty args1) && (not (isForallTy cenv.g e1ty) || isFunTy cenv.g (applyTys cenv.g e1ty (tyargs1,args1))) -> Expr.App(e1,e1ty,tyargs1,args1@[e2],unionRanges e1m m) | _ -> @@ -3081,7 +3079,7 @@ let TryGetNamedArg e = | SimpleEqualsExpr(LongOrSingleIdent(isOpt,LongIdentWithDots([a],_),None,_),b) -> Some(isOpt,a,b) | _ -> None -let IsNamedArg e = isSome (TryGetNamedArg e) +let inline IsNamedArg e = Option.isSome (TryGetNamedArg e) /// Get the method arguments at a callsite, taking into account named and optional arguments let GetMethodArgs arg = @@ -4656,10 +4654,10 @@ and CrackStaticConstantArgs cenv env tpenv (staticParameters: Tainted List.map (function | SynType.StaticConstantNamed(SynType.LongIdent(LongIdentWithDots([id],_)),v,_) -> (Some id, v) | v -> (None, v)) - let unnamedArgs = args |> Seq.takeWhile (fst >> isNone) |> Seq.toArray |> Array.map snd - let otherArgs = args |> List.skipWhile (fst >> isNone) - let namedArgs = otherArgs |> List.takeWhile (fst >> isSome) |> List.map (map1Of2 Option.get) - let otherArgs = otherArgs |> List.skipWhile (fst >> isSome) + let unnamedArgs = args |> Seq.takeWhile (fst >> Option.isNone) |> Seq.toArray |> Array.map snd + let otherArgs = args |> List.skipWhile (fst >> Option.isNone) + let namedArgs = otherArgs |> List.takeWhile (fst >> Option.isSome) |> List.map (map1Of2 Option.get) + let otherArgs = otherArgs |> List.skipWhile (fst >> Option.isSome) if not otherArgs.IsEmpty then error (Error(FSComp.SR.etBadUnnamedStaticArgs(),m)) for (n,_) in namedArgs do @@ -4923,7 +4921,7 @@ and TcSimplePatsOfUnknownType cenv optArgsOK checkCxs env tpenv spats = TcSimplePats cenv optArgsOK checkCxs argty env (tpenv,NameMap.empty,Set.empty) spats and TcPatBindingName cenv env id ty isMemberThis vis1 topValData (inlineFlag,declaredTypars,argAttribs,isMutable,vis2,compgen) (names,takenNames:Set) = - let vis = if isSome vis1 then vis1 else vis2 + let vis = if Option.isSome vis1 then vis1 else vis2 if takenNames.Contains id.idText then errorR (VarBoundTwice id) let baseOrThis = if isMemberThis then MemberThisVal else NormalVal let names = Map.add id.idText (PrelimValScheme1(id,declaredTypars,ty,topValData,None,isMutable,inlineFlag,baseOrThis,argAttribs,vis,compgen)) names @@ -5037,7 +5035,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv,names,takenNames) ty pat (fun values -> TPat_conjs(List.map (fun f -> f values) pats',m)), acc | SynPat.LongIdent (LongIdentWithDots(longId,_),_,tyargs,args,vis,m) -> - if isSome tyargs then errorR(Error(FSComp.SR.tcInvalidTypeArgumentUsage(),m)) + if Option.isSome tyargs then errorR(Error(FSComp.SR.tcInvalidTypeArgumentUsage(),m)) let warnOnUpperForId = match args with | SynConstructorArgs.Pats [] -> warnOnUpper @@ -5077,7 +5075,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv,names,takenNames) ty pat else List.frontAndBack args - if nonNil activePatArgsAsSynPats && apinfo.ActiveTags.Length <> 1 then + if not (List.isEmpty activePatArgsAsSynPats) && apinfo.ActiveTags.Length <> 1 then error(Error(FSComp.SR.tcRequireActivePatternWithOneResult(),m)) // Parse the arguments to an active pattern @@ -5118,7 +5116,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv,names,takenNames) ty pat // The identity of an active pattern consists of its value and the types it is applied to. // If there are any expression args then we've lost identity. - let activePatIdentity = (if nonNil activePatArgsAsSynExprs then None else Some (vref, tinst)) + let activePatIdentity = if List.isEmpty activePatArgsAsSynExprs then Some (vref, tinst) else None (fun values -> // Report information about the 'active recognizer' occurence to IDE CallNameResolutionSink cenv.tcSink (rangeOfLid longId,env.NameEnv,item,item,ItemOccurence.Pattern,env.DisplayEnv,env.eAccessRights) @@ -5780,7 +5778,7 @@ and TcExprUndelayed cenv overallTy env tpenv (expr: SynExpr) = | SynExpr.IfThenElse (e1,e2,e3opt,spIfToThen,isRecovery,mIfToThen,m) -> let e1',tpenv = TcExprThatCantBeCtorBody cenv cenv.g.bool_ty env tpenv e1 let e2',tpenv = - if not isRecovery && isNone e3opt then + if not isRecovery && Option.isNone e3opt then let env = { env with eContextInfo = ContextInfo.OmittedElseBranch } UnifyTypes cenv env m cenv.g.unit_ty overallTy TcExprThatCanBeCtorBody cenv overallTy env tpenv e2 @@ -5848,7 +5846,7 @@ and TcExprUndelayed cenv overallTy env tpenv (expr: SynExpr) = let returnTy = GetFSharpViewOfReturnType cenv.g returnTy let args,namedCallerArgs = GetMethodArgs arg - if nonNil namedCallerArgs then errorR(Error(FSComp.SR.tcNamedArgumentsCannotBeUsedInMemberTraits(),m)) + if not (List.isEmpty namedCallerArgs) then errorR(Error(FSComp.SR.tcNamedArgumentsCannotBeUsedInMemberTraits(),m)) // Subsumption at trait calls if arguments have nominal type prior to unification of any arguments or return type let flexes = argtys |> List.map (isTyparTy cenv.g >> not) let args',tpenv = TcExprs cenv env m tpenv flexes argtys args @@ -6023,8 +6021,7 @@ and TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv wholeExpr e1 indexArg match attemptArrayString with | Some res -> res | None -> - if (isNominal || isSome propName) then - + if isNominal || Option.isSome propName then let nm = match propName with | None -> "Item" @@ -6173,7 +6170,7 @@ and TcRecordConstruction cenv overallTy env tpenv optOrigExpr objTy fldsList m = let ns1 = NameSet.ofList (List.map fst fldsList) let ns2 = NameSet.ofList (List.map (fun x -> x.rfield_id.idText) fspecs) - if isNone optOrigExpr && not (Zset.subset ns2 ns1) then + if Option.isNone optOrigExpr && not (Zset.subset ns2 ns1) then error (MissingFields(Zset.elements (Zset.diff ns2 ns1),m)) if not (Zset.subset ns1 ns2) then @@ -6450,10 +6447,10 @@ and TcObjectExpr cenv overallTy env tpenv (synObjTy,argopt,binds,extraImpls,mNew if // record construction ? (isRecdTy cenv.g objTy) || // object construction? - (isFSharpObjModelTy cenv.g objTy && not (isInterfaceTy cenv.g objTy) && isNone argopt) then + (isFSharpObjModelTy cenv.g objTy && not (isInterfaceTy cenv.g objTy) && Option.isNone argopt) then - if isSome argopt then error(Error(FSComp.SR.tcNoArgumentsForRecordValue(),mWholeExpr)) - if nonNil extraImpls then error(Error(FSComp.SR.tcNoInterfaceImplementationForConstructionExpression(),mNewExpr)) + if Option.isSome argopt then error(Error(FSComp.SR.tcNoArgumentsForRecordValue(),mWholeExpr)) + if not (List.isEmpty extraImpls) then error(Error(FSComp.SR.tcNoInterfaceImplementationForConstructionExpression(),mNewExpr)) if isFSharpObjModelTy cenv.g objTy && GetCtorShapeCounter env <> 1 then error(Error(FSComp.SR.tcObjectConstructionCanOnlyBeUsedInClassTypes(),mNewExpr)) let fldsList = @@ -6479,7 +6476,7 @@ and TcObjectExpr cenv overallTy env tpenv (synObjTy,argopt,binds,extraImpls,mNew errorR(Error(FSComp.SR.tcCannotInheritFromErasedType(),m)) (m,intfTy,overrides),tpenv) - let realObjTy = (if isObjTy cenv.g objTy && nonNil extraImpls then (p23 (List.head extraImpls)) else objTy) + let realObjTy = if isObjTy cenv.g objTy && not (List.isEmpty extraImpls) then (p23 (List.head extraImpls)) else objTy UnifyTypes cenv env mWholeExpr overallTy realObjTy let ctorCall,baseIdOpt,tpenv = @@ -6629,7 +6626,7 @@ and TcConstExpr cenv overallTy env m tpenv c = with _ -> SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromString",SynExpr.Const(SynConst.String (s,m),m),m) let ccu = ccuOfTyconRef mref - if isSome ccu && ccuEq ccu.Value cenv.g.fslibCcu && suffix = "I" then + if Option.isSome ccu && ccuEq ccu.Value cenv.g.fslibCcu && suffix = "I" then SynExpr.Typed(expr,SynType.LongIdent(LongIdentWithDots(pathToSynLid m ["System";"Numerics";"BigInteger"],[])),m) else expr @@ -6663,7 +6660,7 @@ and TcAssertExpr cenv overallTy env (m:range) tpenv x = and TcRecdExpr cenv overallTy env tpenv (inherits, optOrigExpr, flds, mWholeExpr) = let requiresCtor = (GetCtorShapeCounter env = 1) // Get special expression forms for constructors - let haveCtor = (isSome inherits) + let haveCtor = Option.isSome inherits let optOrigExpr,tpenv = match optOrigExpr with @@ -6691,12 +6688,12 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, optOrigExpr, flds, mWholeExpr match flds with | [] -> [] | _ -> - let tcref,_,fldsList = BuildFieldMap cenv env (isSome optOrigExpr) overallTy flds mWholeExpr + let tcref,_,fldsList = BuildFieldMap cenv env (Option.isSome optOrigExpr) overallTy flds mWholeExpr let _,_,_,gtyp = infoOfTyconRef mWholeExpr tcref UnifyTypes cenv env mWholeExpr overallTy gtyp fldsList - if isSome optOrigExpr && not (isRecdTy cenv.g overallTy) then + if Option.isSome optOrigExpr && not (isRecdTy cenv.g overallTy) then errorR(Error(FSComp.SR.tcExpressionFormRequiresRecordTypes(),mWholeExpr)) if requiresCtor || haveCtor then @@ -6706,9 +6703,9 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, optOrigExpr, flds, mWholeExpr if not requiresCtor then errorR(Error(FSComp.SR.tcObjectConstructionExpressionCanOnlyImplementConstructorsInObjectModelTypes(),mWholeExpr)) else - if isNil flds then + if List.isEmpty flds then let errorInfo = - if isSome optOrigExpr then FSComp.SR.tcEmptyCopyAndUpdateRecordInvalid() + if Option.isSome optOrigExpr then FSComp.SR.tcEmptyCopyAndUpdateRecordInvalid() else FSComp.SR.tcEmptyRecordInvalid() error(Error(errorInfo,mWholeExpr)) @@ -6985,9 +6982,9 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | _ -> None /// Decide if the identifier represents a use of a custom query operator - let hasCustomOperations () = not (isNil customOperationMethods) + let hasCustomOperations () = not (List.isEmpty customOperationMethods) - let isCustomOperation nm = tryGetDataForCustomOperation nm |> isSome + let isCustomOperation nm = tryGetDataForCustomOperation nm |> Option.isSome // Check for the MaintainsVariableSpace on custom operation let customOperationMaintainsVarSpace (nm:Ident) = @@ -7213,7 +7210,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv (let _firstSourceSimplePats,later1 = use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink SimplePatsOfPat cenv.synArgNameGenerator firstSourcePat - isNone later1) + Option.isNone later1) -> Some (isFromSource, firstSourcePat, firstSource, nm, secondSourcePat, secondSource, keySelectorsOpt, pat3opt, mOpCore, innerComp) @@ -7371,8 +7368,8 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let firstSourceSimplePats,later1 = SimplePatsOfPat cenv.synArgNameGenerator firstSourcePat let secondSourceSimplePats,later2 = SimplePatsOfPat cenv.synArgNameGenerator secondSourcePat - if isSome later1 then errorR (Error (FSComp.SR.tcJoinMustUseSimplePattern(nm.idText), firstSourcePat.Range)) - if isSome later2 then errorR (Error (FSComp.SR.tcJoinMustUseSimplePattern(nm.idText), secondSourcePat.Range)) + if Option.isSome later1 then errorR (Error (FSComp.SR.tcJoinMustUseSimplePattern(nm.idText), firstSourcePat.Range)) + if Option.isSome later2 then errorR (Error (FSComp.SR.tcJoinMustUseSimplePattern(nm.idText), secondSourcePat.Range)) // check 'join' or 'groupJoin' or 'zip' is permitted for this builder match tryGetDataForCustomOperation nm with @@ -7422,7 +7419,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // groupJoin | Some secondResultPat, Some relExpr when customOperationIsLikeGroupJoin nm -> let secondResultSimplePats,later3 = SimplePatsOfPat cenv.synArgNameGenerator secondResultPat - if isSome later3 then errorR (Error (FSComp.SR.tcJoinMustUseSimplePattern(nm.idText), secondResultPat.Range)) + if Option.isSome later3 then errorR (Error (FSComp.SR.tcJoinMustUseSimplePattern(nm.idText), secondResultPat.Range)) match relExpr with | JoinRelation cenv env (keySelector1, keySelector2) -> mkJoinExpr keySelector1 keySelector2 secondResultSimplePats, varSpaceWithGroupJoinVars @@ -7488,7 +7485,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let mFor = match spForLoop with SequencePointAtForLoop(m) -> m | _ -> pat.Range let mPat = pat.Range let spBind = match spForLoop with SequencePointAtForLoop(m) -> SequencePointAtBinding(m) | NoSequencePointAtForLoop -> NoSequencePointAtStickyBinding - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mFor ad "For" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("For"),mFor)) + if List.isEmpty (TryFindIntrinsicOrExtensionMethInfo cenv env mFor ad "For" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("For"),mFor)) // Add the variables to the query variable space, on demand let varSpace = @@ -7508,23 +7505,23 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let mGuard = guardExpr.Range let mWhile = match spWhile with SequencePointAtWhileLoop(m) -> m | _ -> mGuard if isQuery then error(Error(FSComp.SR.tcNoWhileInQuery(),mWhile)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mWhile ad "While" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("While"),mWhile)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mWhile ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"),mWhile)) + if List.isEmpty (TryFindIntrinsicOrExtensionMethInfo cenv env mWhile ad "While" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("While"),mWhile)) + if List.isEmpty (TryFindIntrinsicOrExtensionMethInfo cenv env mWhile ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"),mWhile)) Some(trans true q varSpace innerComp (fun holeFill -> translatedCtxt (mkSynCall "While" mWhile [mkSynDelay2 guardExpr; mkSynCall "Delay" mWhile [mkSynDelay innerComp.Range holeFill]])) ) | SynExpr.TryFinally (innerComp,unwindExpr,mTryToLast,spTry,_spFinally) -> let mTry = match spTry with SequencePointAtTry(m) -> m | _ -> mTryToLast if isQuery then error(Error(FSComp.SR.tcNoTryFinallyInQuery(),mTry)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "TryFinally" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("TryFinally"),mTry)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"),mTry)) + if List.isEmpty (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "TryFinally" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("TryFinally"),mTry)) + if List.isEmpty (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"),mTry)) Some (translatedCtxt (mkSynCall "TryFinally" mTry [mkSynCall "Delay" mTry [mkSynDelay innerComp.Range (transNoQueryOps innerComp)]; mkSynDelay2 unwindExpr])) | SynExpr.Paren (_,_,_,m) -> error(Error(FSComp.SR.tcConstructIsAmbiguousInComputationExpression(),m)) | SynExpr.ImplicitZero m -> - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Zero" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Zero"),m)) + if List.isEmpty (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Zero" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Zero"),m)) Some (translatedCtxt (mkSynCall "Zero" m [])) | OptionalSequential (JoinOrGroupJoinOrZipClause (_, _, _, _, _, mClause), _) @@ -7681,8 +7678,8 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | SynExpr.ForEach (SequencePointAtForLoop mBind,_,_,_,_,_,_) -> mBind | SynExpr.While (SequencePointAtWhileLoop mWhile,_,_,_) -> mWhile | _ -> innerComp1.Range - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Combine" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Combine"),m)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"),m)) + if List.isEmpty (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Combine" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Combine"),m)) + if List.isEmpty (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"),m)) Some (translatedCtxt (mkSynCall "Combine" m1 [c; mkSynCall "Delay" m1 [mkSynDelay innerComp2.Range (transNoQueryOps innerComp2)]])) | None -> // "do! expr; cexpr" is treated as { let! () = expr in cexpr } @@ -7705,7 +7702,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv Some (translatedCtxt (SynExpr.IfThenElse(guardExpr, transNoQueryOps thenComp, Some(transNoQueryOps elseComp), spIfToThen,isRecovery,mIfToThen,mIfToEndOfElseBranch))) | None -> let elseComp = - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mIfToThen ad "Zero" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Zero"),mIfToThen)) + if List.isEmpty (TryFindIntrinsicOrExtensionMethInfo cenv env mIfToThen ad "Zero" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Zero"),mIfToThen)) mkSynCall "Zero" mIfToThen [] Some (trans true q varSpace thenComp (fun holeFill -> translatedCtxt (SynExpr.IfThenElse(guardExpr, holeFill, Some elseComp, spIfToThen,isRecovery,mIfToThen,mIfToEndOfElseBranch)))) @@ -7746,7 +7743,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv if isQuery then error(Error(FSComp.SR.tcUseMayNotBeUsedInQueries(),bindRange)) let innerCompRange = innerComp.Range let consumeExpr = SynExpr.MatchLambda(false,innerCompRange,[Clause(pat,None, transNoQueryOps innerComp,innerCompRange,SequencePointAtTarget)],spBind,innerCompRange) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Using" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Using"),bindRange)) + if List.isEmpty (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Using" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Using"),bindRange)) Some (translatedCtxt (mkSynCall "Using" bindRange [rhsExpr; consumeExpr ])) // 'let! pat = expr in expr' --> build.Bind(e1,(function _argN -> match _argN with pat -> expr)) @@ -7755,7 +7752,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let bindRange = match spBind with SequencePointAtBinding(m) -> m | _ -> rhsExpr.Range if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(),bindRange)) let innerRange = innerComp.Range - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Bind" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"),bindRange)) + if List.isEmpty (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Bind" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"),bindRange)) // Add the variables to the query variable space, on demand let varSpace = @@ -7775,8 +7772,8 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let bindRange = match spBind with SequencePointAtBinding(m) -> m | _ -> rhsExpr.Range if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(),bindRange)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Using" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Using"),bindRange)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Bind" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"),bindRange)) + if List.isEmpty (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Using" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Using"),bindRange)) + if List.isEmpty (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Bind" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"),bindRange)) let consumeExpr = SynExpr.MatchLambda(false,bindRange,[Clause(pat,None, transNoQueryOps innerComp, innerComp.Range, SequencePointAtTarget)],spBind,bindRange) let consumeExpr = mkSynCall "Using" bindRange [SynExpr.Ident(id); consumeExpr ] let consumeExpr = SynExpr.MatchLambda(false,bindRange,[Clause(pat,None, consumeExpr,id.idRange,SequencePointAtTarget)],spBind,bindRange) @@ -7799,19 +7796,19 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv if isQuery then error(Error(FSComp.SR.tcTryWithMayNotBeUsedInQueries(),mTry)) let clauses = clauses |> List.map (fun (Clause(pat,cond,clauseComp,patm,sp)) -> Clause(pat,cond,transNoQueryOps clauseComp,patm,sp)) let consumeExpr = SynExpr.MatchLambda(true,mTryToLast,clauses,NoSequencePointAtStickyBinding,mTryToLast) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "TryWith" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("TryWith"),mTry)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"),mTry)) + if List.isEmpty (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "TryWith" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("TryWith"),mTry)) + if List.isEmpty (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"),mTry)) Some(translatedCtxt (mkSynCall "TryWith" mTry [mkSynCall "Delay" mTry [mkSynDelay2 (transNoQueryOps innerComp)]; consumeExpr])) | SynExpr.YieldOrReturnFrom((isYield,_),yieldExpr,m) -> let yieldExpr = mkSourceExpr yieldExpr if isYield then - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "YieldFrom" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("YieldFrom"),m)) + if List.isEmpty (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "YieldFrom" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("YieldFrom"),m)) Some (translatedCtxt (mkSynCall "YieldFrom" m [yieldExpr])) else if isQuery then error(Error(FSComp.SR.tcReturnMayNotBeUsedInQueries(),m)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "ReturnFrom" builderTy) then + if List.isEmpty (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "ReturnFrom" builderTy) then errorR(Error(FSComp.SR.tcRequireBuilderMethod("ReturnFrom"),m)) Some (translatedCtxt yieldExpr) else @@ -7821,7 +7818,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | SynExpr.YieldOrReturn((isYield,_),yieldExpr,m) -> let methName = (if isYield then "Yield" else "Return") if isQuery && not isYield then error(Error(FSComp.SR.tcReturnMayNotBeUsedInQueries(),m)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad methName builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod(methName),m)) + if List.isEmpty (TryFindIntrinsicOrExtensionMethInfo cenv env m ad methName builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod(methName),m)) Some(translatedCtxt (mkSynCall methName m [yieldExpr])) | _ -> None @@ -7839,7 +7836,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let rhsExpr = mkSourceExpr rhsExpr if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(),m)) let bodyExpr = - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Return" builderTy) then + if List.isEmpty (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Return" builderTy) then SynExpr.ImplicitZero m else SynExpr.YieldOrReturn((false,true), SynExpr.Const(SynConst.Unit, m), m) @@ -8091,7 +8088,7 @@ and PropagateThenTcDelayed cenv overallTy env tpenv mExpr expr exprty (atomicFla match delayedList with | [] -> // Avoid unifying twice: we're about to unify in TcDelayed - if nonNil delayed then + if not (List.isEmpty delayed) then UnifyTypes cenv env mExpr overallTy exprty | DelayedDot :: _ | DelayedSet _ :: _ @@ -8264,12 +8261,10 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution match delayed with // This is where the constructor is applied to an argument | ((DelayedApp (atomicFlag, (FittedArgs args as origArg), mExprAndArg))::otherDelayed) -> - // assert the overall result type if possible - if isNil otherDelayed then + if List.isEmpty otherDelayed then UnifyTypes cenv env mExprAndArg overallTy ucaseAppTy - let nargs = List.length args UnionCaseOrExnCheck env nargtys nargs mExprAndArg @@ -8552,7 +8547,7 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution match delayed with // Mutable value set: 'v <- e' | DelayedSet(e2,mStmt) :: otherDelayed -> - if nonNil otherDelayed then error(Error(FSComp.SR.tcInvalidAssignment(),mStmt)) + if not (List.isEmpty otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(),mStmt)) UnifyTypes cenv env mStmt overallTy cenv.g.unit_ty vref.Deref.SetHasBeenReferenced() CheckValAccessible mItem env.eAccessRights vref @@ -8598,7 +8593,7 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution PropagateThenTcDelayed cenv overallTy env tpenv mItem vexp vexpty ExprAtomicFlag.Atomic delayed | Item.Property (nm,pinfos) -> - if isNil pinfos then error (InternalError ("Unexpected error: empty property list",mItem)) + if List.isEmpty pinfos then error (InternalError ("Unexpected error: empty property list",mItem)) // if there are both intrinsics and extensions in pinfos, intrinsics will be listed first. // by looking at List.Head we are letting the intrinsics determine indexed/non-indexed let pinfo = List.head pinfos @@ -8610,11 +8605,11 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution match delayed with | DelayedSet(e2,mStmt) :: otherDelayed -> let args = if pinfo.IsIndexer then args else [] - if nonNil otherDelayed then error(Error(FSComp.SR.tcInvalidAssignment(),mStmt)) + if not (List.isEmpty otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(),mStmt)) // Static Property Set (possibly indexer) UnifyTypes cenv env mStmt overallTy cenv.g.unit_ty let meths = pinfos |> SettersOfPropInfos - if isNil meths then error (Error (FSComp.SR.tcPropertyCannotBeSet1 nm,mItem)) + if List.isEmpty meths then error (Error (FSComp.SR.tcPropertyCannotBeSet1 nm,mItem)) let afterTcOverloadResolution = afterOverloadResolution |> AfterTcOverloadResolution.ForProperties nm SettersOfPropInfos // Note: static calls never mutate a struct object argument TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt [] mStmt mItem nm ad NeverMutates true meths afterTcOverloadResolution NormalValUse (args@[e2]) ExprAtomicFlag.NonAtomic otherDelayed @@ -8622,7 +8617,7 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution // Static Property Get (possibly indexer) let meths = pinfos |> GettersOfPropInfos let afterTcOverloadResolution = afterOverloadResolution |> AfterTcOverloadResolution.ForProperties nm GettersOfPropInfos - if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable(nm),mItem)) + if List.isEmpty meths then error (Error (FSComp.SR.tcPropertyIsNotReadable(nm),mItem)) // Note: static calls never mutate a struct object argument TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt [] mItem mItem nm ad NeverMutates true meths afterTcOverloadResolution NormalValUse args ExprAtomicFlag.Atomic delayed @@ -8668,7 +8663,7 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution let fieldTy = rfinfo.FieldType match delayed with | DelayedSet(e2,mStmt) :: otherDelayed -> - if nonNil otherDelayed then error(Error(FSComp.SR.tcInvalidAssignment(),mStmt)) + if not (List.isEmpty otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(),mStmt)) // Set static F# field CheckRecdFieldMutation mItem env.DisplayEnv rfinfo @@ -8678,7 +8673,6 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution let e2',tpenv = TcExprFlex cenv true fieldTy env tpenv e2 let expr = mkStaticRecdFieldSet (rfinfo.RecdFieldRef,rfinfo.TypeInst,e2',mStmt) expr,tpenv - | _ -> let exprty = fieldTy let expr = @@ -8776,7 +8770,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela | Item.Property (nm,pinfos) -> // Instance property - if isNil pinfos then error (InternalError ("Unexpected error: empty property list",mItem)) + if List.isEmpty pinfos then error (InternalError ("Unexpected error: empty property list",mItem)) // if there are both intrinsics and extensions in pinfos, intrinsics will be listed first. // by looking at List.Head we are letting the intrinsics determine indexed/non-indexed let pinfo = List.head pinfos @@ -8790,18 +8784,18 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela match delayed with | DelayedSet(e2,mStmt) :: otherDelayed -> let args = if pinfo.IsIndexer then args else [] - if nonNil otherDelayed then error(Error(FSComp.SR.tcInvalidAssignment(),mStmt)) + if not (List.isEmpty otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(),mStmt)) // Instance property setter UnifyTypes cenv env mStmt overallTy cenv.g.unit_ty let meths = SettersOfPropInfos pinfos - if isNil meths then error (Error (FSComp.SR.tcPropertyCannotBeSet1 nm,mItem)) + if List.isEmpty meths then error (Error (FSComp.SR.tcPropertyCannotBeSet1 nm,mItem)) let afterTcOverloadResolution = afterOverloadResolution |> AfterTcOverloadResolution.ForProperties nm SettersOfPropInfos let mut = (if isStructTy cenv.g (tyOfExpr cenv.g objExpr) then DefinitelyMutates else PossiblyMutates) TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt objArgs mStmt mItem nm ad mut true meths afterTcOverloadResolution NormalValUse (args @ [e2]) atomicFlag [] | _ -> // Instance property getter let meths = GettersOfPropInfos pinfos - if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable(nm),mItem)) + if List.isEmpty meths then error (Error (FSComp.SR.tcPropertyIsNotReadable(nm),mItem)) let afterTcOverloadResolution = afterOverloadResolution |> AfterTcOverloadResolution.ForProperties nm GettersOfPropInfos TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterTcOverloadResolution NormalValUse args atomicFlag delayed @@ -8816,7 +8810,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela match delayed with | DelayedSet(e2,mStmt) :: otherDelayed -> // Mutable value set: 'v <- e' - if nonNil otherDelayed then error(Error(FSComp.SR.tcInvalidAssignment(),mItem)) + if not (List.isEmpty otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(),mItem)) CheckRecdFieldMutation mItem env.DisplayEnv rfinfo UnifyTypes cenv env mStmt overallTy cenv.g.unit_ty // Always allow subsumption on assignment to fields @@ -8931,14 +8925,14 @@ and TcMethodApplicationThen // Work out if we know anything about the return type of the overall expression. If there are any delayed // lookups then we don't know anything. - let exprTy = if isNil delayed then overallTy else NewInferenceType () + let exprTy = if List.isEmpty delayed then overallTy else NewInferenceType () // Call the helper below to do the real checking let (expr,attributeAssignedNamedItems,delayed),tpenv = TcMethodApplication false cenv env tpenv callerTyArgs objArgs mWholeExpr mItem methodName objTyOpt ad mut isProp meths afterTcOverloadResolution isSuperInit args exprTy delayed // Give errors if some things couldn't be assigned - if nonNil attributeAssignedNamedItems then + if not (List.isEmpty attributeAssignedNamedItems) then let (CallerNamedArg(id,_)) = List.head attributeAssignedNamedItems errorR(Error(FSComp.SR.tcNamedArgumentDidNotMatch(id.idText),id.idRange)) @@ -9044,7 +9038,7 @@ and TcMethodApplication // x.M ((x,y)) match candidates with | [calledMeth] - when (namedCurriedCallerArgs |> List.forall isNil && + when (namedCurriedCallerArgs |> List.forall List.isEmpty && let curriedCalledArgs = calledMeth.GetParamAttribs(cenv.amap, mItem) curriedCalledArgs.Length = 1 && curriedCalledArgs.Head.Length = 1 && @@ -9061,7 +9055,7 @@ and TcMethodApplication // Without this rule this requires // x.M (fst p,snd p) | [calledMeth] - when (namedCurriedCallerArgs |> List.forall isNil && + when (namedCurriedCallerArgs |> List.forall List.isEmpty && unnamedCurriedCallerArgs.Length = 1 && unnamedCurriedCallerArgs.Head.Length = 1 && let curriedCalledArgs = calledMeth.GetParamAttribs(cenv.amap, mItem) @@ -9106,7 +9100,7 @@ and TcMethodApplication resultTy) curriedArgTys,returnTy - if isProp && isNone curriedCallerArgsOpt then + if isProp && Option.isNone curriedCallerArgsOpt then error(Error(FSComp.SR.parsIndexerPropertyRequiresAtLeastOneArgument(),mItem)) // STEP 1. UnifyUniqueOverloading. This happens BEFORE we type check the arguments. @@ -9323,7 +9317,7 @@ and TcMethodApplication finalCalledPropInfoOpt |> Option.iter (fun pinfo -> CheckPropInfoAttributes pinfo mItem |> CommitOperationResult) - let isInstance = nonNil objArgs + let isInstance = not (List.isEmpty objArgs) MethInfoChecks cenv.g cenv.amap isInstance tyargsOpt objArgs ad mItem finalCalledMethInfo // Adhoc constraints on use of .NET methods @@ -9612,7 +9606,7 @@ and TcMethodApplication // Bind "out" parameters as part of the result tuple let expr,exprty = - if isNil outArgTmpBinds then expr,exprty + if List.isEmpty outArgTmpBinds then expr,exprty else let outArgTys = outArgExprs |> List.map (tyOfExpr cenv.g) let expr = if isUnitTy cenv.g exprty then mkCompGenSequential mMethExpr expr (mkRefTupled cenv.g mMethExpr outArgExprs outArgTys) @@ -9622,7 +9616,7 @@ and TcMethodApplication // Handle post-hoc property assignments let expr = - if isNil finalAssignedItemSetters then expr else + if List.isEmpty finalAssignedItemSetters then expr else // This holds the result of the call let objv,objExpr = mkMutableCompGenLocal mMethExpr "returnVal" exprty // mutable in case it's a struct // This expression mutates the properties on the result of the call @@ -9992,7 +9986,7 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt // Check the attributes of the binding, parameters or return value let TcAttrs tgt attrs = let attrs = TcAttributes cenv envinner tgt attrs - if attrTgt = enum 0 && nonNil attrs then + if attrTgt = enum 0 && not (List.isEmpty attrs) then errorR(Error(FSComp.SR.tcAttributesAreNotPermittedOnLetBindings(),mBinding)) attrs @@ -10032,25 +10026,25 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt if not declKind.CanBeDllImport || (match memberFlagsOpt with Some memberFlags -> memberFlags.IsInstance | _ -> false) then errorR(Error(FSComp.SR.tcDllImportNotAllowed(),mBinding)) - if HasFSharpAttribute cenv.g cenv.g.attrib_ConditionalAttribute valAttribs && isNone(memberFlagsOpt) then + if HasFSharpAttribute cenv.g cenv.g.attrib_ConditionalAttribute valAttribs && Option.isNone memberFlagsOpt then errorR(Error(FSComp.SR.tcConditionalAttributeRequiresMembers(),mBinding)) if HasFSharpAttribute cenv.g cenv.g.attrib_EntryPointAttribute valAttribs then - if isSome(memberFlagsOpt) then + if Option.isSome memberFlagsOpt then errorR(Error(FSComp.SR.tcEntryPointAttributeRequiresFunctionInModule(),mBinding)) else UnifyTypes cenv env mBinding overallPatTy (mkArrayType cenv.g cenv.g.string_ty --> cenv.g.int_ty) if isMutable && isInline then errorR(Error(FSComp.SR.tcMutableValuesCannotBeInline(),mBinding)) - if isMutable && nonNil declaredTypars then errorR(Error(FSComp.SR.tcMutableValuesMayNotHaveGenericParameters(),mBinding)) + if isMutable && not (List.isEmpty declaredTypars) then errorR(Error(FSComp.SR.tcMutableValuesMayNotHaveGenericParameters(),mBinding)) let flex = if isMutable then dontInferTypars else flex - if isMutable && nonNil spatsL then errorR(Error(FSComp.SR.tcMutableValuesSyntax(),mBinding)) + if isMutable && not (List.isEmpty spatsL) then errorR(Error(FSComp.SR.tcMutableValuesSyntax(),mBinding)) let isInline = - if isInline && isNil spatsL && isNil declaredTypars then + if isInline && List.isEmpty spatsL && List.isEmpty declaredTypars then errorR(Error(FSComp.SR.tcOnlyFunctionsCanBeInline(),mBinding)) false else @@ -10079,7 +10073,7 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt let envinner = match apinfoOpt with | Some (apinfo,ty,m) -> - if isSome memberFlagsOpt || (not apinfo.IsTotal && apinfo.ActiveTags.Length > 1) then + if Option.isSome memberFlagsOpt || (not apinfo.IsTotal && apinfo.ActiveTags.Length > 1) then error(Error(FSComp.SR.tcInvalidActivePatternName(),mBinding)) apinfo.ActiveTagsWithRanges |> List.iteri (fun i (_tag,tagRange) -> @@ -10132,7 +10126,7 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt errorR(Error(FSComp.SR.tcLiteralCannotBeMutable(),mBinding)) if hasLiteralAttr && isInline then errorR(Error(FSComp.SR.tcLiteralCannotBeInline(),mBinding)) - if hasLiteralAttr && nonNil declaredTypars then + if hasLiteralAttr && not (List.isEmpty declaredTypars) then errorR(Error(FSComp.SR.tcLiteralCannotHaveGenericParameters(),mBinding)) CheckedBindingInfo(inlineFlag,valAttribs,doc,tcPatPhase2,flex,nameToPrelimValSchemeMap,rhsExprChecked,argAndRetAttribs,overallPatTy,mBinding,spBind,compgen,konst,isFixed),tpenv @@ -10408,7 +10402,7 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (binds,bindsm,scope let maxInferredTypars = freeInTypeLeftToRight cenv.g false tauTy let generalizedTypars = - if isNil maxInferredTypars && isNil allDeclaredTypars then + if List.isEmpty maxInferredTypars && List.isEmpty allDeclaredTypars then [] else let freeInEnv = lazyFreeInEnv.Force() @@ -10432,10 +10426,9 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (binds,bindsm,scope match pat' with // Don't introduce temporary or 'let' for 'match against wild' or 'match against unit' - | (TPat_wild _ | TPat_const (Const.Unit,_)) when not isUse && not isFixed && isNil generalizedTypars -> + | (TPat_wild _ | TPat_const (Const.Unit,_)) when not isUse && not isFixed && List.isEmpty generalizedTypars -> let mk_seq_bind (tm,tmty) = (mkSequential SequencePointsAtSeq m rhsExpr tm, tmty) (mk_seq_bind << mkf_sofar,env,tpenv) - | _ -> // nice: don't introduce awful temporary for r.h.s. in the 99% case where we know what we're binding it to @@ -10511,7 +10504,7 @@ and CheckMemberFlags _g optIntfSlotTy newslotsOK overridesOK memberFlags m = errorR(Error(FSComp.SR.tcAbstractMembersIllegalInAugmentation(),m)) if overridesOK = ErrorOnOverrides && memberFlags.MemberKind = MemberKind.Constructor then errorR(Error(FSComp.SR.tcConstructorsIllegalInAugmentation(),m)) - if overridesOK = WarnOnOverrides && memberFlags.IsOverrideOrExplicitImpl && isNone optIntfSlotTy then + if overridesOK = WarnOnOverrides && memberFlags.IsOverrideOrExplicitImpl && Option.isNone optIntfSlotTy then warning(OverrideInIntrinsicAugmentation(m)) if overridesOK = ErrorOnOverrides && memberFlags.IsOverrideOrExplicitImpl then error(Error(FSComp.SR.tcMethodOverridesIllegalHere(),m)) @@ -10660,7 +10653,7 @@ and ApplyAbstractSlotInference cenv (envinner:TcEnv) (bindingTy,m,synTyparDecls, let _,typarsFromAbsSlot,argTysFromAbsSlot, retTyFromAbsSlot = FreshenAbstractSlot cenv.g cenv.amap m synTyparDecls uniqueAbstractMeth - if nonNil typarsFromAbsSlot then + if not (List.isEmpty typarsFromAbsSlot) then errorR(InternalError("Unexpected generic property",memberId.idRange)) let absSlotTy = @@ -10717,7 +10710,7 @@ and AnalyzeRecursiveStaticMemberOrValDecl (cenv, envinner: TcEnv, tpenv, declKin match tcrefContainerInfo, memberFlagsOpt with | (Some(MemberOrValContainerInfo(tcref, optIntfSlotTy, baseValOpt, _safeInitInfo, declaredTyconTypars)),Some memberFlags) -> - assert (isNone(optIntfSlotTy)) + assert (Option.isNone optIntfSlotTy) CheckMemberFlags cenv.g None newslotsOK overridesOK memberFlags id.idRange CheckForNonAbstractInterface declKind tcref memberFlags id.idRange @@ -10784,10 +10777,9 @@ and AnalyzeRecursiveInstanceMemberDecl (cenv,envinner: TcEnv, tpenv, declKind, s CheckMemberFlags cenv.g optIntfSlotTy newslotsOK overridesOK memberFlags mBinding - if isSome vis && memberFlags.IsOverrideOrExplicitImpl then + if Option.isSome vis && memberFlags.IsOverrideOrExplicitImpl then errorR(Error(FSComp.SR.tcOverridesCannotHaveVisibilityDeclarations(),memberId.idRange)) - - + // Syntactically push the "this" variable across to be a lambda on the right let bindingRhs = PushOnePatternToRhs cenv true (mkSynThisPatVar thisId) bindingRhs @@ -10910,8 +10902,7 @@ and AnalyzeAndMakeAndPublishRecursiveValue overridesOK isGeneratedEventVal cenv newslotsOK, overridesOK, vis1, declPattern, bindingAttribs, tcrefContainerInfo, memberFlagsOpt, ty, bindingRhs, mBinding) - - let optArgsOK = isSome(memberFlagsOpt) + let optArgsOK = Option.isSome memberFlagsOpt // Assert the types given in the argument patterns ApplyTypesFromArgumentPatterns(cenv,envinner,optArgsOK,ty,mBinding,tpenv,bindingRhs,memberFlagsOpt) @@ -11866,7 +11857,7 @@ module IncrClassChecking = // Create the values with the given names let _,vspecs = MakeSimpleVals cenv env names - if tcref.IsStructOrEnumTycon && isNil spats then + if tcref.IsStructOrEnumTycon && List.isEmpty spats then errorR (ParameterlessStructCtor(tcref.Range)) // Put them in order @@ -12499,8 +12490,8 @@ module IncrClassChecking = TransTrueDec true reps (IncrClassBindingGroup(binds,false,false)) // We expect that only ctorInitActions1 will be non-empty here, and even then only if some elements are stored in the field - assert (isNil cctorInitActions1) - assert (isNil methodBinds1) + assert (List.isEmpty cctorInitActions1) + assert (List.isEmpty methodBinds1) // Now deal with all the 'let' and 'member' declarations let initActions,reps = List.mapFold TransDec reps decs @@ -12754,7 +12745,7 @@ module MutRecBindingChecking = // Code for potential future design change to allow functions-compiled-as-members in structs errorR(Error(FSComp.SR.tcStructsMayNotContainLetBindings(),(trimRangeToLine m))) - if isStatic && isNone incrClassCtorLhsOpt then + if isStatic && Option.isNone incrClassCtorLhsOpt then errorR(Error(FSComp.SR.tcStaticLetBindingsRequireClassesWithImplicitConstructors(),m)) // Phase2A: let-bindings - pass through @@ -13372,7 +13363,7 @@ module MutRecBindingChecking = | _ -> () ]) // Now check they don't escape the overall scope of the recursive set of types - if nonNil allExtraGeneralizableTypars then + if not (List.isEmpty allExtraGeneralizableTypars) then let freeInInitialEnv = GeneralizationHelpers.ComputeUngeneralizableTypars envInitial for extraTypar in allExtraGeneralizableTypars do if Zset.memberOf freeInInitialEnv extraTypar then @@ -13458,11 +13449,11 @@ let TcMutRecDefns_Phase2 cenv envInitial bindsm scopem mutRecNSInfo (envMutRec: if not (tcref.HasInterface cenv.g ity') then error(Error(FSComp.SR.tcAllImplementedInterfacesShouldBeDeclared(),ity.Range)) - if (typeEquiv cenv.g ity' cenv.g.mk_IComparable_ty && isSome tcref.GeneratedCompareToValues) || - (typeEquiv cenv.g ity' cenv.g.mk_IStructuralComparable_ty && isSome tcref.GeneratedCompareToWithComparerValues) || - (typeEquiv cenv.g ity' ((mkAppTy cenv.g.system_GenericIComparable_tcref [typ])) && isSome tcref.GeneratedCompareToValues) || - (typeEquiv cenv.g ity' ((mkAppTy cenv.g.system_GenericIEquatable_tcref [typ])) && isSome tcref.GeneratedHashAndEqualsWithComparerValues) || - (typeEquiv cenv.g ity' cenv.g.mk_IStructuralEquatable_ty && isSome tcref.GeneratedHashAndEqualsWithComparerValues) then + if (typeEquiv cenv.g ity' cenv.g.mk_IComparable_ty && Option.isSome tcref.GeneratedCompareToValues) || + (typeEquiv cenv.g ity' cenv.g.mk_IStructuralComparable_ty && Option.isSome tcref.GeneratedCompareToWithComparerValues) || + (typeEquiv cenv.g ity' ((mkAppTy cenv.g.system_GenericIComparable_tcref [typ])) && Option.isSome tcref.GeneratedCompareToValues) || + (typeEquiv cenv.g ity' ((mkAppTy cenv.g.system_GenericIEquatable_tcref [typ])) && Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues) || + (typeEquiv cenv.g ity' cenv.g.mk_IStructuralEquatable_ty && Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues) then errorR(Error(FSComp.SR.tcDefaultImplementationForInterfaceHasAlreadyBeenAdded(),ity.Range)) if overridesOK = WarnOnOverrides then warning(IntfImplInIntrinsicAugmentation(ity.Range)) @@ -13608,19 +13599,19 @@ module AddAugmentationDeclarations = let AddGenericCompareBindings cenv (tycon:Tycon) = - if (* AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare cenv.g tycon && *) isSome tycon.GeneratedCompareToValues then + if (* AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare cenv.g tycon && *) Option.isSome tycon.GeneratedCompareToValues then AugmentWithHashCompare.MakeBindingsForCompareAugmentation cenv.g tycon else [] let AddGenericCompareWithComparerBindings cenv (tycon:Tycon) = - if (* AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare cenv.g tycon && *) isSome tycon.GeneratedCompareToWithComparerValues then + if (* AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare cenv.g tycon && *) Option.isSome tycon.GeneratedCompareToWithComparerValues then (AugmentWithHashCompare.MakeBindingsForCompareWithComparerAugmentation cenv.g tycon) else [] let AddGenericEqualityWithComparerBindings cenv (tycon:Tycon) = - if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals cenv.g tycon && isSome tycon.GeneratedHashAndEqualsWithComparerValues then + if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals cenv.g tycon && Option.isSome tycon.GeneratedHashAndEqualsWithComparerValues then (AugmentWithHashCompare.MakeBindingsForEqualityWithComparerAugmentation cenv.g tycon) else [] @@ -13653,7 +13644,7 @@ module AddAugmentationDeclarations = // Note: only provide the equals method if Equals is not implemented explicitly, and // we're actually generating Hash/Equals for this type if not hasExplicitObjectEqualsOverride && - isSome tycon.GeneratedHashAndEqualsWithComparerValues then + Option.isSome tycon.GeneratedHashAndEqualsWithComparerValues then let vspec1,vspec2 = AugmentWithHashCompare.MakeValsForEqualsAugmentation cenv.g tcref tcaug.SetEquals (mkLocalValRef vspec1, mkLocalValRef vspec2) @@ -13850,7 +13841,7 @@ module TyconConstraintInference = (if initialAssumedTycons.Contains tcref.Stamp then assumedTycons.Contains tcref.Stamp elif AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals g tcref.Deref then - isSome tcref.GeneratedHashAndEqualsWithComparerValues + Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues else true) && @@ -14099,8 +14090,8 @@ module EstablishTypeDefinitionCores = if hasClassAttr || hasAbstractClassAttr || hasMeasureAttr then TyconClass elif hasInterfaceAttr then TyconInterface elif hasStructAttr then TyconStruct - elif isConcrete || nonNil fields then TyconClass - elif isNil slotsigs && inSig then TyconHiddenRepr + elif isConcrete || not (List.isEmpty fields) then TyconClass + elif List.isEmpty slotsigs && inSig then TyconHiddenRepr else TyconInterface | k -> if hasClassAttr && not (match k with TyconClass -> true | _ -> false) || @@ -14116,7 +14107,7 @@ module EstablishTypeDefinitionCores = | SynTypeDefnSimpleRepr.TypeAbbrev(_, SynType.LongIdent(LongIdentWithDots([unionCaseName],_)),m) when (not hasMeasureAttr && - (isNil (LookupTypeNameInEnvNoArity OpenQualified unionCaseName.idText envinner.eNameResEnv) || + (List.isEmpty (LookupTypeNameInEnvNoArity OpenQualified unionCaseName.idText envinner.eNameResEnv) || id.idText = unionCaseName.idText)) -> Some(unionCaseName,m) | _ -> @@ -14162,7 +14153,7 @@ module EstablishTypeDefinitionCores = for arg in ctorArgNames do let ty = names.[arg].Type let m = names.[arg].Ident.idRange - if nonNil (ListSet.subtract typarEq (freeInTypeLeftToRight cenv.g false ty) tycon.TyparsNoRange) then + if not (List.isEmpty (ListSet.subtract typarEq (freeInTypeLeftToRight cenv.g false ty) tycon.TyparsNoRange)) then errorR(Error(FSComp.SR.tcStructsMustDeclareTypesOfImplicitCtorArgsExplicitly(),m)) yield (ty, m) @@ -14287,7 +14278,7 @@ module EstablishTypeDefinitionCores = if hasMeasureAttr then tycon.Data.entity_kind <- TyparKind.Measure - if nonNil typars then error(Error(FSComp.SR.tcMeasureDefinitionsCannotHaveTypeParameters(),m)) + if not (List.isEmpty typars) then error(Error(FSComp.SR.tcMeasureDefinitionsCannotHaveTypeParameters(),m)) let repr = match synTyconRepr with @@ -14404,9 +14395,8 @@ module EstablishTypeDefinitionCores = let tcref = mkLocalTyconRef tycon try - let resolutionEnvironment = - - if nonNil args then + let resolutionEnvironment = + if not (List.isEmpty args) then checkTypeName() let resolutionEnvironment = match tcrefForContainer.TypeReprInfo with @@ -14950,7 +14940,7 @@ module EstablishTypeDefinitionCores = noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedStruct noAbstractClassAttributeCheck() noAllowNullLiteralAttributeCheck() - if nonNil slotsigs then + if not (List.isEmpty slotsigs) then errorR (Error(FSComp.SR.tcStructTypesCannotContainAbstractMembers(),m)) structLayoutAttributeCheck(true) @@ -15683,7 +15673,7 @@ module TcDeclarations = let isConcrete = members |> List.exists (function | SynMemberDefn.Member(Binding(_,_,_,_,_,_,SynValData(Some memberFlags,_,_),_,_,_,_,_),_) -> not memberFlags.IsDispatchSlot - | SynMemberDefn.Interface (_,defOpt,_) -> isSome defOpt + | SynMemberDefn.Interface (_,defOpt,_) -> Option.isSome defOpt | SynMemberDefn.LetBindings _ -> true | SynMemberDefn.ImplicitCtor _ -> true | SynMemberDefn.ImplicitInherit _ -> true @@ -15711,7 +15701,7 @@ module TcDeclarations = members |> List.exists (function | SynMemberDefn.Member(Binding(_,_,_,_,_,_,SynValData(Some memberFlags,_,_),SynPatForConstructorDecl(SynPatForNullaryArgs),_,_,_,_),_) -> memberFlags.MemberKind=MemberKind.Constructor - | SynMemberDefn.ImplicitCtor (_,_,spats,_, _) -> isNil spats + | SynMemberDefn.ImplicitCtor (_,_,spats,_, _) -> List.isEmpty spats | _ -> false) let repr = SynTypeDefnSimpleRepr.General(kind,inherits,slotsigs,fields,isConcrete,isIncrClass,implicitCtorSynPats,m) let isAtOriginalTyconDefn = not (isAugmentationTyconDefnRepr repr) @@ -15754,7 +15744,7 @@ module TcDeclarations = let (ComponentInfo(_,typars, cs,longPath, _, _, _,_)) = synTyconInfo let declKind, tcref, declaredTyconTypars = ComputeTyconDeclKind tyconOpt isAtOriginalTyconDefn cenv envForDecls false tyDeclRange typars cs longPath let newslotsOK = (if isAtOriginalTyconDefn && tcref.IsFSharpObjectModelTycon then NewSlotsOK else NoNewSlots) - if nonNil members && tcref.IsTypeAbbrev then + if not (List.isEmpty members) && tcref.IsTypeAbbrev then errorR(Error(FSComp.SR.tcTypeAbbreviationsCannotHaveAugmentations(), tyDeclRange)) MutRecDefnsPhase2DataForTycon(tyconOpt, innerParent, declKind, tcref, baseValOpt, safeInitInfo, declaredTyconTypars, members, tyDeclRange, newslotsOK, fixupFinalAttrs)) @@ -15845,7 +15835,7 @@ module TcDeclarations = // 'type X with ...' in a signature is always interpreted as an extrinsic extension. // Representation-hidden types with members and interfaces are written 'type X = ...' - | SynTypeDefnSigRepr.Simple((SynTypeDefnSimpleRepr.None _ as r),_) when nonNil extraMembers -> + | SynTypeDefnSigRepr.Simple((SynTypeDefnSimpleRepr.None _ as r),_) when not (List.isEmpty extraMembers) -> let isAtOriginalTyconDefn = false let tyconCore = MutRecDefnsPhase1DataForTycon (synTyconInfo, r, implements1, false, false, isAtOriginalTyconDefn) tyconCore, (synTyconInfo,extraMembers) @@ -16026,7 +16016,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS MutRecBindingChecking.TcMutRecDefns_UpdateNSContents nsInfo let env = - if isNil enclosingNamespacePath then + if List.isEmpty enclosingNamespacePath then envAtEnd else let env = AddLocalRootModuleOrNamespace cenv.tcSink cenv.g cenv.amap m env mtypRoot @@ -16071,7 +16061,7 @@ and TcSignatureElementsNonMutRec cenv parent endm env defs = | SynModuleSigDecl.Types (typeSpecs,_) -> for (TypeDefnSig(ComponentInfo(_,_,_,ids,_,_,_,_),trepr,extraMembers,_)) in typeSpecs do match trepr with - | SynTypeDefnSigRepr.Simple((SynTypeDefnSimpleRepr.None _),_) when nonNil extraMembers -> () + | SynTypeDefnSigRepr.Simple((SynTypeDefnSimpleRepr.None _),_) when not (List.isEmpty extraMembers) -> () | _ -> yield (List.last ids).idText | _ -> () ] |> set @@ -16343,10 +16333,9 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv:cenv) parent typeNames scopem MutRecBindingChecking.TcMutRecDefns_UpdateNSContents nsInfo let env = - if isNil enclosingNamespacePath then + if List.isEmpty enclosingNamespacePath then envAtEnd else - let env = AddLocalRootModuleOrNamespace cenv.tcSink cenv.g cenv.amap m env mtypRoot // If the namespace is an interactive fragment e.g. FSI_0002, then open FSI_0002 in the subsequent environment @@ -16375,7 +16364,7 @@ and TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm (defsSoFar, | (firstDef :: otherDefs) -> // Lookahead one to find out the scope of the next declaration. let scopem = - if isNil otherDefs then unionRanges firstDef.Range endm + if List.isEmpty otherDefs then unionRanges firstDef.Range endm else unionRanges (List.head otherDefs).Range endm // Possibly better: @@ -16526,7 +16515,7 @@ let ApplyAssemblyLevelAutoOpenAttributeToTcEnv g amap (ccu: CcuThunk) scopem env warning(Error(FSComp.SR.tcAttributeAutoOpenWasIgnored(p, ccu.AssemblyName),scopem)) env let p = splitNamespace p - if isNil p then warn() else + if List.isEmpty p then warn() else let h,t = List.frontAndBack p let modref = mkNonLocalTyconRef (mkNonLocalEntityRef ccu (Array.ofList h)) t match modref.TryDeref with @@ -16621,10 +16610,8 @@ let ApplyDefaults cenv g denvAtEnd m mexpr extraAttribs = ConstraintSolver.ChooseTyparSolutionAndSolve cenv.css denvAtEnd tp) with e -> errorRecovery e m - let CheckValueRestriction denvAtEnd rootSigOpt implFileTypePriorToSig m = - if isNone rootSigOpt then - + if Option.isNone rootSigOpt then let rec check (mty:ModuleOrNamespaceType) = for v in mty.AllValsAndMembers do let ftyvs = (freeInVal CollectTyparsNoCaching v).FreeTypars |> Zset.elements @@ -16696,7 +16683,7 @@ let TypeCheckOneImplFile (ParsedImplFileInput(_,isScript,qualNameOfFile,scopedPragmas,_,implFileFrags,isLastCompiland)) = eventually { - let cenv = cenv.Create (g, isScript, niceNameGen, amap, topCcu, false, isSome rootSigOpt, conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g)) + let cenv = cenv.Create (g, isScript, niceNameGen, amap, topCcu, false, Option.isSome rootSigOpt, conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g)) let envinner, mtypeAcc = MakeInitialEnv env diff --git a/src/fsharp/TypeRelations.fs b/src/fsharp/TypeRelations.fs index 201f8d790a6..c3cdc8d3382 100644 --- a/src/fsharp/TypeRelations.fs +++ b/src/fsharp/TypeRelations.fs @@ -259,7 +259,7 @@ let tryDestTopLambda g amap (ValReprInfo (tpNames,_,_) as tvd) (e,ty) = let n = tvd.NumCurriedArgs let tps,taue,tauty = match e with - | Expr.TyLambda (_,tps,b,_,retTy) when nonNil tpNames -> tps,b,retTy + | Expr.TyLambda (_,tps,b,_,retTy) when not (List.isEmpty tpNames) -> tps,b,retTy | _ -> [],e,ty let ctorThisValOpt,baseValOpt,vsl,body,retTy = startStripLambdaUpto n (taue,tauty) if vsl.Length <> n then diff --git a/src/fsharp/ast.fs b/src/fsharp/ast.fs index 3a17d24684c..d1447739531 100644 --- a/src/fsharp/ast.fs +++ b/src/fsharp/ast.fs @@ -1675,7 +1675,7 @@ let PushPatternToExpr synArgNameGenerator isMember pat (rhs: SynExpr) = let private isSimplePattern pat = let _nowpats,laterf = SimplePatsOfPat (SynArgNameGenerator()) pat - isNone laterf + Option.isNone laterf /// "fun (UnionCase x) (UnionCase y) -> body" /// ==> @@ -1879,7 +1879,7 @@ module SynInfo = let selfMetadata = unnamedTopArg /// Determine if a syntactic information represents a member without arguments (which is implicitly a property getter) - let HasNoArgs (SynValInfo(args,_)) = isNil args + let HasNoArgs (SynValInfo(args,_)) = List.isEmpty args /// Check if one particular argument is an optional argument. Used when adjusting the /// types of optional arguments for function and member signatures. diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index a6b22c1f088..43b1659e453 100755 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -199,7 +199,7 @@ type DisposablesTracker() = /// Type checking a set of inputs let TypeCheck (tcConfig, tcImports, tcGlobals, errorLogger:ErrorLogger, assemblyName, niceNameGen, tcEnv0, inputs, exiter: Exiter) = try - if isNil inputs then error(Error(FSComp.SR.fscNoImplementationFiles(),Range.rangeStartup)) + if List.isEmpty inputs then error(Error(FSComp.SR.fscNoImplementationFiles(),Range.rangeStartup)) let ccuName = assemblyName let tcInitialState = GetInitialTcState (rangeStartup,ccuName,tcConfig,tcGlobals,tcImports,niceNameGen,tcEnv0) TypeCheckClosedInputSet ((fun () -> errorLogger.ErrorCount > 0),tcConfig,tcImports,tcGlobals,None,tcInitialState,inputs) @@ -1260,7 +1260,7 @@ module StaticLinker = let debugStaticLinking = condition "FSHARP_DEBUG_STATIC_LINKING" let StaticLinkILModules (tcConfig, ilGlobals, ilxMainModule, dependentILModules: (CcuThunk option * ILModuleDef) list) = - if isNil dependentILModules then + if List.isEmpty dependentILModules then ilxMainModule,(fun x -> x) else @@ -1441,7 +1441,7 @@ module StaticLinker = begin let remaining = ref (computeILRefs ilxMainModule).AssemblyReferences - while nonNil !remaining do + while not (List.isEmpty !remaining) do let ilAssemRef = List.head !remaining remaining := List.tail !remaining if assumedIndependentSet.Contains ilAssemRef.Name || (ilAssemRef.PublicKey = Some ecmaPublicKey) then @@ -1503,7 +1503,7 @@ module StaticLinker = ] let remaining = ref roots - [ while nonNil !remaining do + [ while not (List.isEmpty !remaining) do let n = List.head !remaining remaining := List.tail !remaining if not n.visited then @@ -1614,7 +1614,7 @@ module StaticLinker = // Build the ILTypeDefs for generated types, starting with the roots let generatedILTypeDefs = let rec buildRelocatedGeneratedType (ProviderGeneratedType(ilOrigTyRef, ilTgtTyRef, ch)) = - let isNested = ilTgtTyRef.Enclosing |> nonNil + let isNested = not (List.isEmpty ilTgtTyRef.Enclosing) if allTypeDefsInProviderGeneratedAssemblies.ContainsKey ilOrigTyRef then let ilOrigTypeDef = allTypeDefsInProviderGeneratedAssemblies.[ilOrigTyRef] if debugStaticLinking then printfn "Relocating %s to %s " ilOrigTyRef.QualifiedName ilTgtTyRef.QualifiedName @@ -1714,7 +1714,7 @@ type SigningInfo = SigningInfo of (* delaysign:*) bool * (* publicsign:*) bool * let GetSigner signingInfo = let (SigningInfo(delaysign,publicsign,signer,container)) = signingInfo // REVIEW: favor the container over the key file - C# appears to do this - if isSome container then + if Option.isSome container then Some(ILBinaryWriter.ILStrongNameSigner.OpenKeyContainer container.Value) else match signer with diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index c4b2759f917..9af45e894ae 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -714,7 +714,7 @@ type internal FsiConsoleInput(fsiOptions: FsiCommandLineOptions, inReader: TextR (new Thread(fun () -> match consoleOpt with | Some console when fsiOptions.EnableConsoleKeyProcessing && not fsiOptions.IsInteractiveServer -> - if isNil fsiOptions.SourceFiles then + if List.isEmpty fsiOptions.SourceFiles then if !progress then fprintfn outWriter "first-line-reader-thread reading first line..."; firstLine <- Some(console.ReadLine()); if !progress then fprintfn outWriter "first-line-reader-thread got first line = %A..." firstLine; @@ -1077,7 +1077,7 @@ type internal FsiDynamicCompiler |> List.unzip errorLogger.AbortOnError(); - if inputs |> List.exists isNone then failwith "parse error"; + if inputs |> List.exists Option.isNone then failwith "parse error" let inputs = List.map Option.get inputs let istate = List.fold2 fsiDynamicCompiler.ProcessMetaCommandsFromInputAsInteractiveCommands istate sourceFiles inputs fsiDynamicCompiler.EvalParsedSourceFiles (istate, inputs) @@ -1900,7 +1900,7 @@ type internal FsiInteractionProcessor let istate = consume istate fsiOptions.SourceFiles - if nonNil fsiOptions.SourceFiles then + if not (List.isEmpty fsiOptions.SourceFiles) then fsiConsolePrompt.PrintAhead(); // Seems required. I expected this could be deleted. Why not? istate @@ -2282,7 +2282,7 @@ type internal FsiEvaluationSession (argv:string[], inReader:TextReader, outWrite do fsiConsoleOutput.uprintfn "" // When no source files to load, print ahead prompt here - do if isNil fsiOptions.SourceFiles then + do if List.isEmpty fsiOptions.SourceFiles then fsiConsolePrompt.PrintAhead() diff --git a/src/fsharp/infos.fs b/src/fsharp/infos.fs index 5a171a6b023..b37590c88ad 100755 --- a/src/fsharp/infos.fs +++ b/src/fsharp/infos.fs @@ -369,7 +369,7 @@ type ValRef with member vref.IsDefiniteFSharpOverrideMember = let membInfo = vref.MemberInfo.Value let flags = membInfo.MemberFlags - not flags.IsDispatchSlot && (flags.IsOverrideOrExplicitImpl || nonNil membInfo.ImplementedSlotSigs) + not flags.IsDispatchSlot && (flags.IsOverrideOrExplicitImpl || not (List.isEmpty membInfo.ImplementedSlotSigs)) /// Check if an F#-declared member value is an explicit interface member implementation member vref.IsFSharpExplicitInterfaceImplementation g = @@ -785,7 +785,7 @@ type ILMethInfo = member x.IsDllImport g = match g.attrib_DllImportAttribute with | None -> false - | Some (AttribInfo(tref,_)) ->x.RawMetadata.CustomAttrs |> TryDecodeILAttribute g tref |> isSome + | Some (AttribInfo(tref,_)) ->x.RawMetadata.CustomAttrs |> TryDecodeILAttribute g tref |> Option.isSome /// Get the (zero or one) 'self'/'this'/'object' arguments associated with an IL method. /// An instance extension method returns one object argument. @@ -1689,10 +1689,10 @@ type ILPropInfo = ILMethInfo(g,x.ILTypeInfo.ToType,None,mdef,[]) /// Indicates if the IL property has a 'get' method - member x.HasGetter = isSome x.RawMetadata.GetMethod + member x.HasGetter = Option.isSome x.RawMetadata.GetMethod /// Indicates if the IL property has a 'set' method - member x.HasSetter = isSome x.RawMetadata.SetMethod + member x.HasSetter = Option.isSome x.RawMetadata.SetMethod /// Indicates if the IL property is static member x.IsStatic = (x.RawMetadata.CallingConv = ILThisConvention.Static) @@ -1771,7 +1771,7 @@ type PropInfo = member x.HasGetter = match x with | ILProp(_,x) -> x.HasGetter - | FSProp(_,_,x,_) -> isSome x + | FSProp(_,_,x,_) -> Option.isSome x #if EXTENSIONTYPING | ProvidedProp(_,pi,m) -> pi.PUntaint((fun pi -> pi.CanRead),m) #endif @@ -1780,7 +1780,7 @@ type PropInfo = member x.HasSetter = match x with | ILProp(_,x) -> x.HasSetter - | FSProp(_,_,_,x) -> isSome x + | FSProp(_,_,_,x) -> Option.isSome x #if EXTENSIONTYPING | ProvidedProp(_,pi,m) -> pi.PUntaint((fun pi -> pi.CanWrite),m) #endif @@ -2218,7 +2218,7 @@ type EventInfo = | ILEvent(_,ILEventInfo(tinfo,edef)) -> // Get the delegate type associated with an IL event, taking into account the instantiation of the // declaring type. - if isNone edef.Type then error (nonStandardEventError x.EventName m) + if Option.isNone edef.Type then error (nonStandardEventError x.EventName m) ImportILTypeFromMetadata amap m tinfo.ILScopeRef tinfo.TypeInst [] edef.Type.Value | FSEvent(g,p,_,_) -> diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index c055a6e6614..53d5ec743a5 100755 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -53,7 +53,7 @@ let mkUnderscoreRecdField m = LongIdentWithDots([ident("_", m)], []), false let mkRecdField lidwd = lidwd, true let mkSynDoBinding (vis,strict,expr,m) = - if isSome vis then errorR(Error(FSComp.SR.parsDoCannotHaveVisibilityDeclarations(),m)); + if Option.isSome vis then errorR(Error(FSComp.SR.parsDoCannotHaveVisibilityDeclarations(),m)); Binding (None, (if strict then DoBinding else StandaloneExpression), false,false,[],PreXmlDoc.Empty,SynInfo.emptySynValData, @@ -111,20 +111,20 @@ let mkClassMemberLocalBindings(isStatic,initialRangeOpt,attrs,vis,BindingSetPreA match initialRangeOpt with | None -> bindingSetRange | Some m -> unionRanges m bindingSetRange - if nonNil ignoredFreeAttrs then warning(Error(FSComp.SR.parsAttributesIgnored(),wholeRange)); + if not (List.isEmpty ignoredFreeAttrs) then warning(Error(FSComp.SR.parsAttributesIgnored(),wholeRange)); if isUse then errorR(Error(FSComp.SR.parsUseBindingsIllegalInImplicitClassConstructors(),wholeRange)) SynMemberDefn.LetBindings (decls,isStatic,isRec,wholeRange) let mkLocalBindings (mWhole,BindingSetPreAttrs(_,isRec,isUse,declsPreAttrs,_),body) = let ignoredFreeAttrs,decls = declsPreAttrs [] None - if nonNil ignoredFreeAttrs then warning(Error(FSComp.SR.parsAttributesIgnored(),mWhole)) + if not (List.isEmpty ignoredFreeAttrs) then warning(Error(FSComp.SR.parsAttributesIgnored(),mWhole)) SynExpr.LetOrUse (isRec,isUse,decls,body,mWhole) let mkDefnBindings (mWhole,BindingSetPreAttrs(_,isRec,isUse,declsPreAttrs,_bindingSetRange),attrs,vis,attrsm) = if isUse then warning(Error(FSComp.SR.parsUseBindingsIllegalInModules(),mWhole)) let freeAttrs,decls = declsPreAttrs attrs vis let letDecls = [ SynModuleDecl.Let (isRec,decls,mWhole) ] - let attrDecls = if nonNil freeAttrs then [ SynModuleDecl.Attributes (freeAttrs,attrsm) ] else [] + let attrDecls = if not (List.isEmpty freeAttrs) then [ SynModuleDecl.Attributes (freeAttrs,attrsm) ] else [] attrDecls @ letDecls let idOfPat m p = @@ -134,7 +134,7 @@ let idOfPat m p = | _ -> raiseParseErrorAt m (FSComp.SR.parsIntegerForLoopRequiresSimpleIdentifier()) let checkForMultipleAugmentations m a1 a2 = - if nonNil a1 && nonNil a2 then raiseParseErrorAt m (FSComp.SR.parsOnlyOneWithAugmentationAllowed()) + if not (List.isEmpty a1) && not (List.isEmpty a2) then raiseParseErrorAt m (FSComp.SR.parsOnlyOneWithAugmentationAllowed()) a1 @ a2 let grabXmlDoc(parseState:IParseState,elemIdx) = @@ -547,8 +547,8 @@ interactiveDefns: /* An expression as part of one interaction in F# Interactive */ interactiveExpr: | opt_attributes opt_declVisibility declExpr - { if isSome $2 then errorR(Error(FSComp.SR.parsUnexpectedVisibilityDeclaration(),rhs parseState 3)) - let attrDecls = if nonNil $1 then [ SynModuleDecl.Attributes ($1, rangeOfNonNilAttrs $1) ] else [] in + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsUnexpectedVisibilityDeclaration(),rhs parseState 3)) + let attrDecls = if not (List.isEmpty $1) then [ SynModuleDecl.Attributes ($1, rangeOfNonNilAttrs $1) ] else [] in attrDecls @ [ mkSynDoDecl($3)] } @@ -664,12 +664,12 @@ fileNamespaceSpec: /* The single module declaration that can make up a signature file */ fileModuleSpec: | opt_attributes opt_declVisibility moduleIntro moduleSpfnsPossiblyEmptyBlock - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let m2 = rhs parseState 3 let m = (rhs2 parseState 3 4) let isRec,path2,xml,vis = $3 (fun (isRec2,path,_) -> - if nonNil path then errorR(Error(FSComp.SR.parsNamespaceOrModuleNotBoth(),m2)) + if not (List.isEmpty path) then errorR(Error(FSComp.SR.parsNamespaceOrModuleNotBoth(),m2)) let lid = path@path2 ParsedSigFileFragment.NamedModule(SynModuleOrNamespaceSig(lid, (isRec || isRec2), true, $4, xml,$1,vis,m))) } @@ -728,12 +728,12 @@ moduleSpfn: { $1 } | opt_attributes opt_declVisibility moduleIntro colonOrEquals namedModuleAbbrevBlock - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { 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 isSome(vis) then raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsIgnoreVisibilityOnModuleAbbreviationAlwaysPrivate()) + if Option.isSome vis then raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsIgnoreVisibilityOnModuleAbbreviationAlwaysPrivate()) SynModuleSigDecl.ModuleAbbrev(List.head path,$5,rhs2 parseState 3 5) } | opt_attributes opt_declVisibility moduleIntro colonOrEquals moduleSpecBlock @@ -741,11 +741,11 @@ moduleSpfn: if List.length path <> 1 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 isSome($2) then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) SynModuleSigDecl.NestedModule(info, isRec, $5, rhs2 parseState 3 5) } | opt_attributes opt_declVisibility tyconSpfns - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let (TypeDefnSig(ComponentInfo(cas,a,cs,b,c,d,d2,d3),e,f,g)),rest = match $3 with | [] -> raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedEmptyModuleDefn()) @@ -754,7 +754,7 @@ moduleSpfn: SynModuleSigDecl.Types (tc::rest,rhs parseState 3) } | opt_attributes opt_declVisibility exconSpfn - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let (SynExceptionSig(SynExceptionDefnRepr(cas,a,b,c,d,d2),e,f)) = $3 let ec = (SynExceptionSig(SynExceptionDefnRepr($1@cas,a,b,c,d,d2),e,f)) SynModuleSigDecl.Exception(ec, rhs parseState 3) } @@ -764,9 +764,9 @@ moduleSpfn: valSpfn: | opt_attributes opt_declVisibility VAL opt_attributes opt_inline opt_mutable opt_access nameop opt_explicitValTyparDecls COLON topTypeWithTypeConstraints optLiteralValueSpfn - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let attr1,attr2,isInline,isMutable,vis2,id,doc,explicitValTyparDecls,(ty,arity),konst = ($1),($4),($5),($6),($7),($8),grabXmlDoc(parseState,3),($9),($11),($12) - if nonNil attr2 then errorR(Deprecated(FSComp.SR.parsAttributesMustComeBeforeVal(),rhs parseState 4)) + if not (List.isEmpty attr2) then errorR(Deprecated(FSComp.SR.parsAttributesMustComeBeforeVal(),rhs parseState 4)) let m = rhs2 parseState 3 11 let valSpfn = ValSpfn((attr1@attr2),id,explicitValTyparDecls,ty,arity,isInline,isMutable,doc, vis2,konst,m) SynModuleSigDecl.Val(valSpfn,m) @@ -855,7 +855,7 @@ tyconSpfnRhs: { let m = lhs parseState let needsCheck,(kind,decls) = $1 (fun nameRange nameInfo augmentation -> - if needsCheck && isNil decls then + if needsCheck && List.isEmpty decls then reportParseErrorAt nameRange (FSComp.SR.parsEmptyTypeDefinition()) TypeDefnSig(nameInfo,SynTypeDefnSigRepr.ObjectModel (kind,decls,m),augmentation,m)) } @@ -864,7 +864,7 @@ tyconSpfnRhs: let ty,arity = $3 let invoke = SynMemberSig.Member(ValSpfn([],mkSynId m "Invoke",inferredTyparDecls,ty,arity,false,false,PreXmlDoc.Empty,None,None,m),AbstractMemberFlags MemberKind.Member,m) (fun nameRange nameInfo augmentation -> - if nonNil augmentation then raiseParseErrorAt m (FSComp.SR.parsAugmentationsIllegalOnDelegateType()) + if not (List.isEmpty augmentation) then raiseParseErrorAt m (FSComp.SR.parsAugmentationsIllegalOnDelegateType()) TypeDefnSig(nameInfo,SynTypeDefnSigRepr.ObjectModel (TyconDelegate (ty,arity),[invoke],m),[],m)) } @@ -932,7 +932,7 @@ classSpfnMembersAtLeastOne: /* A object member in a signature */ classMemberSpfn: | opt_attributes opt_declVisibility memberSpecFlags opt_inline opt_access nameop opt_explicitValTyparDecls COLON topTypeWithTypeConstraints classMemberSpfnGetSet optLiteralValueSpfn - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let isInline,doc,vis2,id,explicitValTyparDecls,(ty,arity),optLiteralValue = $4,grabXmlDoc(parseState,3),$5,$6,$7,$9,$11 let getSetRangeOpt, getSet = $10 let getSetAdjuster arity = match arity,getSet with SynValInfo([],_),MemberKind.Member -> MemberKind.PropertyGet | _ -> getSet @@ -946,24 +946,24 @@ classMemberSpfn: SynMemberSig.Member(valSpfn, flags (getSetAdjuster arity),wholeRange) } | opt_attributes opt_declVisibility interfaceMember appType - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) SynMemberSig.Interface ($4,unionRanges (rhs parseState 3) ($4).Range) } | opt_attributes opt_declVisibility INHERIT appType - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) SynMemberSig.Inherit ($4,unionRanges (rhs parseState 3) ($4).Range) } | opt_attributes opt_declVisibility VAL fieldDecl - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let fld = $4 $1 false SynMemberSig.ValField(fld,rhs2 parseState 3 4) } | opt_attributes opt_declVisibility STATIC VAL fieldDecl - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) SynMemberSig.ValField($5 $1 true,rhs2 parseState 3 5) } | opt_attributes opt_declVisibility STATIC typeKeyword tyconSpfn - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) SynMemberSig.NestedType($5,rhs2 parseState 3 5) } | opt_attributes opt_declVisibility NEW COLON topTypeWithTypeConstraints @@ -1085,12 +1085,12 @@ fileNamespaceImpl: /* A single module definition in an implementation file */ fileModuleImpl: | opt_attributes opt_declVisibility moduleIntro moduleDefnsOrExprPossiblyEmptyOrBlock - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let m2 = rhs parseState 3 let m = (m2, $4) ||> unionRangeWithListBy (fun modu -> modu.Range) let isRec2,path2,xml,vis = $3 (fun (isRec, path, _) -> - if nonNil path then errorR(Error(FSComp.SR.parsNamespaceOrModuleNotBoth(),m2)) + if not (List.isEmpty path) then errorR(Error(FSComp.SR.parsNamespaceOrModuleNotBoth(),m2)) let lid = path@path2 ParsedImplFileFragment.NamedModule(SynModuleOrNamespace(lid, (isRec || isRec2), true, $4, xml,$1,vis,m))) } @@ -1132,25 +1132,25 @@ moduleDefnsOrExprPossiblyEmpty: /* A naked expression is only allowed at the start of a module/file, or straight after a topSeparators */ moduleDefnsOrExpr: | opt_attributes opt_declVisibility declExpr topSeparators moduleDefnsOrExpr - { if isSome $2 then errorR(Error(FSComp.SR.parsUnexpectedVisibilityDeclaration(),rhs parseState 3)) - let attrDecls = if nonNil $1 then [ SynModuleDecl.Attributes ($1, rangeOfNonNilAttrs $1) ] else [] + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsUnexpectedVisibilityDeclaration(),rhs parseState 3)) + let attrDecls = if not (List.isEmpty $1) then [ SynModuleDecl.Attributes ($1, rangeOfNonNilAttrs $1) ] else [] attrDecls @ mkSynDoDecl ($3) :: $5 } | opt_attributes opt_declVisibility declExpr topSeparators - { if isSome $2 then errorR(Error(FSComp.SR.parsUnexpectedVisibilityDeclaration(),rhs parseState 3)) - let attrDecls = if nonNil $1 then [ SynModuleDecl.Attributes ($1, rangeOfNonNilAttrs $1) ] else [] + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsUnexpectedVisibilityDeclaration(),rhs parseState 3)) + let attrDecls = if not (List.isEmpty $1) then [ SynModuleDecl.Attributes ($1, rangeOfNonNilAttrs $1) ] else [] attrDecls @ [ mkSynDoDecl($3) ] } | opt_attributes opt_declVisibility declExpr - { if isSome $2 then errorR(Error(FSComp.SR.parsUnexpectedVisibilityDeclaration(),rhs parseState 3)) - let attrDecls = if nonNil $1 then [ SynModuleDecl.Attributes ($1, rangeOfNonNilAttrs $1) ] else [] + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsUnexpectedVisibilityDeclaration(),rhs parseState 3)) + let attrDecls = if not (List.isEmpty $1) then [ SynModuleDecl.Attributes ($1, rangeOfNonNilAttrs $1) ] else [] attrDecls @ [ mkSynDoDecl($3) ] } | moduleDefns { $1 } | opt_attributes error - { if nonNil $1 then [ SynModuleDecl.Attributes ($1, rangeOfNonNilAttrs $1) ] else [] } + { if not (List.isEmpty $1) then [ SynModuleDecl.Attributes ($1, rangeOfNonNilAttrs $1) ] else [] } /* A sequence of definitions in a namespace or module */ @@ -1186,7 +1186,7 @@ moduleDefn: /* 'let' definitions in non-#light*/ | opt_attributes opt_declVisibility defnBindings %prec decl_let - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) parseState.ResetSynArgNameGenerator() let (BindingSetPreAttrs(_,_,_,_,mWhole)) = $3 mkDefnBindings (mWhole,$3,$1,$2,mWhole) } @@ -1194,19 +1194,19 @@ moduleDefn: /* 'let' or 'do' definitions in #light */ | opt_attributes opt_declVisibility hardwhiteLetBindings %prec decl_let { let hwlb,m = $3 - if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) parseState.ResetSynArgNameGenerator() mkDefnBindings (m,hwlb,$1,$2,m) } /* 'do' definitions in non-#light*/ | opt_attributes opt_declVisibility doBinding %prec decl_let - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let mWhole = rhs parseState 3 mkDefnBindings (mWhole,$3,$1,$2,mWhole) } /* 'type' definitions */ | opt_attributes opt_declVisibility typeKeyword tyconDefn tyconDefnList - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let (TypeDefn(ComponentInfo(cas ,a,cs,b,c,d,d2,d3),e,f,g)) = $4 let tc = (TypeDefn(ComponentInfo($1@cas,a,cs,b,c,d,d2,d3),e,f,g)) let types = tc :: $5 @@ -1214,7 +1214,7 @@ moduleDefn: /* 'exception' definitions */ | opt_attributes opt_declVisibility exconDefn - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let (SynExceptionDefn(SynExceptionDefnRepr(cas,a,b,c,d,d2),e,f)) = $3 let f = (f, $1) ||> unionRangeWithListBy (fun a -> a.Range) let ec = (SynExceptionDefn(SynExceptionDefnRepr($1@cas,a,b,c,d,d2),e,f)) @@ -1222,15 +1222,15 @@ moduleDefn: /* 'module' definitions */ | opt_attributes opt_declVisibility moduleIntro EQUALS namedModuleDefnBlock - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let attribs, (isRec, path, xml, vis) = $1,$3 match $5 with | Choice1Of2 eqn -> - if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + 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 isSome vis then raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsIgnoreAttributesOnModuleAbbreviationAlwaysPrivate()) + if Option.isSome vis then raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsIgnoreAttributesOnModuleAbbreviationAlwaysPrivate()) [ 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()) @@ -1494,7 +1494,7 @@ tyconDefnRhs: | None -> (lhs parseState).StartRange // create a zero-width range | Some m -> m (fun nameRange augmentation -> - if needsCheck && isNil decls then + if needsCheck && List.isEmpty decls then reportParseErrorAt nameRange (FSComp.SR.parsEmptyTypeDefinition()) SynTypeDefnRepr.ObjectModel (kind,decls,m),augmentation) } @@ -1505,7 +1505,7 @@ tyconDefnRhs: (fun nameRange augmentation -> let valSpfn = ValSpfn([],mkSynId m "Invoke",inferredTyparDecls,ty,arity,false,false,PreXmlDoc.Empty,None,None,m) let invoke = SynMemberDefn.AbstractSlot(valSpfn,AbstractMemberFlags MemberKind.Member,m) - if nonNil augmentation then raiseParseErrorAt m (FSComp.SR.parsAugmentationsIllegalOnDelegateType()) + if not (List.isEmpty augmentation) then raiseParseErrorAt m (FSComp.SR.parsAugmentationsIllegalOnDelegateType()) SynTypeDefnRepr.ObjectModel (TyconDelegate (ty,arity),[invoke],m),[]) } @@ -1798,21 +1798,21 @@ abstractMemberFlags: /* A member definition */ classDefnMember: | opt_attributes opt_declVisibility classDefnBindings - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) [mkClassMemberLocalBindings(false,None,$1,$2,$3)] } | opt_attributes opt_declVisibility STATIC classDefnBindings - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) [mkClassMemberLocalBindings(true,Some (rhs parseState 3),$1,$2,$4)] } | opt_attributes opt_declVisibility memberFlags memberCore opt_ODECLEND - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let _,flags = $3 $4 $2 flags $1 } | opt_attributes opt_declVisibility interfaceMember appType opt_interfaceImplDefn - { if nonNil $1 then errorR(Error(FSComp.SR.parsAttributesAreNotPermittedOnInterfaceImplementations(),rhs parseState 1)) - if isSome $2 then errorR(Error(FSComp.SR.parsInterfacesHaveSameVisibilityAsEnclosingType(),rhs parseState 3)) + { if not (List.isEmpty $1) then errorR(Error(FSComp.SR.parsAttributesAreNotPermittedOnInterfaceImplementations(),rhs parseState 1)) + if Option.isSome $2 then errorR(Error(FSComp.SR.parsInterfacesHaveSameVisibilityAsEnclosingType(),rhs parseState 3)) let mWhole = match $5 with | None -> rhs2 parseState 3 4 @@ -1829,25 +1829,25 @@ classDefnMember: match getSetRangeOpt with | None -> unionRanges m ty.Range | Some m2 -> unionRanges m m2 - if isSome $2 then errorR(Error(FSComp.SR.parsAccessibilityModsIllegalForAbstract(),wholeRange)) + if Option.isSome $2 then errorR(Error(FSComp.SR.parsAccessibilityModsIllegalForAbstract(),wholeRange)) let valSpfn = ValSpfn($1,id,explicitValTyparDecls,ty,arity, isInline,false,doc, None,None,wholeRange) [ SynMemberDefn.AbstractSlot(valSpfn,AbstractMemberFlags (getSetAdjuster arity), wholeRange) ] } | opt_attributes opt_declVisibility inheritsDefn - { if nonNil $1 then errorR(Error(FSComp.SR.parsAttributesIllegalOnInherit(),rhs parseState 1)) - if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityIllegalOnInherit(),rhs parseState 1)) + { if not (List.isEmpty $1) then errorR(Error(FSComp.SR.parsAttributesIllegalOnInherit(),rhs parseState 1)) + if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityIllegalOnInherit(),rhs parseState 1)) [ $3 ] } | opt_attributes opt_declVisibility valDefnDecl opt_ODECLEND - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) $3 None $1 false } | opt_attributes opt_declVisibility STATIC valDefnDecl opt_ODECLEND - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) $4 (Some (rhs parseState 3)) $1 true } | opt_attributes opt_declVisibility memberFlags autoPropsDefnDecl opt_ODECLEND - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let isStatic, flags = $3 $4 $1 isStatic flags } @@ -1862,7 +1862,7 @@ classDefnMember: [ SynMemberDefn.Member(Binding (None,NormalBinding,false,false,$1,grabXmlDoc(parseState,3),valSynData, declPat,None,expr,m,NoSequencePointAtInvisibleBinding),m) ] } | opt_attributes opt_declVisibility STATIC typeKeyword tyconDefn - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) [ SynMemberDefn.NestedType($5,None,rhs2 parseState 3 5) ] } @@ -2018,17 +2018,17 @@ tyconDefnOrSpfnSimpleRepr: /* A type abbreviation */ | opt_attributes opt_declVisibility typ - { if nonNil $1 then errorR(Error(FSComp.SR.parsAttributesIllegalHere(),rhs parseState 1)) - if isSome $2 then errorR(Error(FSComp.SR.parsTypeAbbreviationsCannotHaveVisibilityDeclarations(),rhs parseState 2)) + { if not (List.isEmpty $1) then errorR(Error(FSComp.SR.parsAttributesIllegalHere(),rhs parseState 1)) + if Option.isSome $2 then errorR(Error(FSComp.SR.parsTypeAbbreviationsCannotHaveVisibilityDeclarations(),rhs parseState 2)) SynTypeDefnSimpleRepr.TypeAbbrev (ParserDetail.Ok, $3, unionRanges (rhs parseState 1) $3.Range) } /* A union type definition */ | opt_attributes opt_declVisibility unionTypeRepr - { if nonNil $1 then errorR(Error(FSComp.SR.parsAttributesIllegalHere(),rhs parseState 1)) + { if not (List.isEmpty $1) then errorR(Error(FSComp.SR.parsAttributesIllegalHere(),rhs parseState 1)) let rangesOf3 = $3 |> List.map (function |Choice1Of2(ec)->ec.Range | Choice2Of2(uc)->uc.Range) let mWhole = (rhs2 parseState 1 2, rangesOf3) ||> List.fold unionRanges if $3 |> List.exists (function Choice1Of2 _ -> true | _ -> false) then ( - if isSome $2 then errorR(Error(FSComp.SR.parsEnumTypesCannotHaveVisibilityDeclarations(),rhs parseState 2)); + if Option.isSome $2 then errorR(Error(FSComp.SR.parsEnumTypesCannotHaveVisibilityDeclarations(),rhs parseState 2)); SynTypeDefnSimpleRepr.Enum ($3 |> List.choose (function | Choice1Of2 data -> Some(data) @@ -2042,14 +2042,14 @@ tyconDefnOrSpfnSimpleRepr: /* A record type definition */ | opt_attributes opt_declVisibility braceFieldDeclList - { if nonNil $1 then errorR(Error(FSComp.SR.parsAttributesIllegalHere(),rhs parseState 1)) + { if not (List.isEmpty $1) then errorR(Error(FSComp.SR.parsAttributesIllegalHere(),rhs parseState 1)) SynTypeDefnSimpleRepr.Record ($2,$3,lhs parseState) } /* An inline-assembly type definition, for FSharp.Core library only */ | opt_attributes opt_declVisibility LPAREN inlineAssemblyTyconRepr rparen - { if nonNil $1 then errorR(Error(FSComp.SR.parsAttributesIllegalHere(),rhs parseState 1)) + { if not (List.isEmpty $1) then errorR(Error(FSComp.SR.parsAttributesIllegalHere(),rhs parseState 1)) libraryOnlyError (lhs parseState) - if isSome $2 then errorR(Error(FSComp.SR.parsInlineAssemblyCannotHaveVisibilityDeclarations(),rhs parseState 2)) + if Option.isSome $2 then errorR(Error(FSComp.SR.parsInlineAssemblyCannotHaveVisibilityDeclarations(),rhs parseState 2)) $4 } @@ -2220,26 +2220,26 @@ attrUnionCaseDecls: /* The core of a union case definition */ attrUnionCaseDecl: | opt_attributes opt_access unionCaseName opt_OBLOCKSEP - { if isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(),rhs parseState 2)) let mDecl = rhs parseState 3 (fun xmlDoc -> Choice2Of2 (UnionCase ( $1, $3,UnionCaseFields [],xmlDoc,None,mDecl))) } | opt_attributes opt_access unionCaseName OF unionCaseRepr opt_OBLOCKSEP - { if isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(),rhs parseState 2)) let mDecl = rhs2 parseState 3 5 (fun xmlDoc -> Choice2Of2 (UnionCase ( $1, $3,UnionCaseFields $5,xmlDoc,None,mDecl))) } | opt_attributes opt_access unionCaseName COLON topType opt_OBLOCKSEP - { if isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(),rhs parseState 2)) libraryOnlyWarning(lhs parseState) let mDecl = rhs2 parseState 3 5 (fun xmlDoc -> Choice2Of2 (UnionCase ( $1, $3,UnionCaseFullType $5,xmlDoc,None,mDecl))) } | opt_attributes opt_access unionCaseName EQUALS constant opt_OBLOCKSEP - { if isSome $2 then errorR(Error(FSComp.SR.parsEnumFieldsCannotHaveVisibilityDeclarations(),rhs parseState 2)) + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsEnumFieldsCannotHaveVisibilityDeclarations(),rhs parseState 2)) let mDecl = rhs2 parseState 3 5 (fun xmlDoc -> Choice1Of2 (EnumCase ( $1, $3,$5,xmlDoc,mDecl))) } @@ -2301,7 +2301,7 @@ recdFieldDecl: | opt_attributes fieldDecl { let fld = $2 $1 false let (Field(a,b,c,d,e,f,vis,g)) = fld - if isSome vis then errorR(Error(FSComp.SR.parsRecordFieldsCannotHaveVisibilityDeclarations(),rhs parseState 2)) + if Option.isSome vis then errorR(Error(FSComp.SR.parsRecordFieldsCannotHaveVisibilityDeclarations(),rhs parseState 2)) Field(a,b,c,d,e,f,None,g) } /* Part of a field or val declaration in a record type or object type */ diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index 27cecaa4e43..799ea4af9ed 100755 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -3430,11 +3430,11 @@ and CcuThunk = name: CcuReference } member ccu.Deref = - if isNull ccu.target || ccu.orphanfixup then + if isNull (ccu.target :> obj) || ccu.orphanfixup then raise(UnresolvedReferenceNoRange ccu.name) ccu.target - member ccu.IsUnresolvedReference = (isNull ccu.target || ccu.orphanfixup) + member ccu.IsUnresolvedReference = isNull (ccu.target :> obj) || ccu.orphanfixup /// Ensure the ccu is derefable in advance. Supply a path to attach to any resulting error message. member ccu.EnsureDerefable(requiringPath:string[]) = diff --git a/src/fsharp/vs/ServiceDeclarations.fs b/src/fsharp/vs/ServiceDeclarations.fs index a6482c6d31c..4ebff683f50 100644 --- a/src/fsharp/vs/ServiceDeclarations.fs +++ b/src/fsharp/vs/ServiceDeclarations.fs @@ -663,7 +663,7 @@ module internal ItemDescriptionsImpl = NicePrint.outputTyconRef denv os ucinfo.TyconRef bprintf os ".%s: " (DecompileOpName uc.Id.idText) - if not (isNil recd) then + if not (List.isEmpty recd) then NicePrint.outputUnionCases denv os recd os.Append (" -> ") |> ignore NicePrint.outputTy denv os rty ) @@ -864,7 +864,7 @@ module internal ItemDescriptionsImpl = | _ -> st) |> Seq.mapi (fun i x -> i,x) |> Seq.toList - if nonNil namesToAdd then + if not (List.isEmpty namesToAdd) then bprintf os "\n" for i, txt in namesToAdd do bprintf os "\n%s" ((if i = 0 then FSComp.SR.typeInfoFromFirst else FSComp.SR.typeInfoFromNext) txt) diff --git a/src/fsharp/vs/ServiceUntypedParse.fs b/src/fsharp/vs/ServiceUntypedParse.fs index 52f280ab9c2..3797daef7b0 100755 --- a/src/fsharp/vs/ServiceUntypedParse.fs +++ b/src/fsharp/vs/ServiceUntypedParse.fs @@ -122,9 +122,9 @@ type FSharpParseFileResults(errors : FSharpErrorInfo[], input : Ast.ParsedInput let rec walkBind (Binding(_, _, _, _, _, _, SynValData(memFlagsOpt,_,_), synPat, _, synExpr, _, spInfo)) = [ // Don't yield the binding sequence point if there are any arguments, i.e. we're defining a function or a method let isFunction = - isSome memFlagsOpt || + Option.isSome memFlagsOpt || match synPat with - | SynPat.LongIdent (_,_,_, SynConstructorArgs.Pats args,_,_) when nonNil args -> true + | SynPat.LongIdent (_,_,_, SynConstructorArgs.Pats args,_,_) when not (List.isEmpty args) -> true | _ -> false if not isFunction then yield! walkBindSeqPt spInfo diff --git a/src/fsharp/vs/Symbols.fs b/src/fsharp/vs/Symbols.fs index 2c911afaf8e..531f120797b 100644 --- a/src/fsharp/vs/Symbols.fs +++ b/src/fsharp/vs/Symbols.fs @@ -1231,7 +1231,7 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = match d with | E e -> let dty = e.GetDelegateType(cenv.amap,range0) - TryDestStandardDelegateTyp cenv.infoReader range0 AccessibleFromSomewhere dty |> isSome + TryDestStandardDelegateTyp cenv.infoReader range0 AccessibleFromSomewhere dty |> Option.isSome | P _ | M _ | V _ -> invalidOp "the value or member is not an event" member __.HasSetterMethod = @@ -1333,7 +1333,7 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = | M m when m.LogicalName.StartsWith("add_") -> let eventName = m.LogicalName.[4..] let entityTy = generalizedTyconRef m.DeclaringEntityRef - nonNil (cenv.infoReader.GetImmediateIntrinsicEventsOfType (Some eventName, AccessibleFromSomeFSharpCode, range0, entityTy)) || + not (List.isEmpty (cenv.infoReader.GetImmediateIntrinsicEventsOfType (Some eventName, AccessibleFromSomeFSharpCode, range0, entityTy))) || match GetImmediateIntrinsicPropInfosOfType(Some eventName, AccessibleFromSomeFSharpCode) cenv.g cenv.amap range0 (generalizedTyconRef m.DeclaringEntityRef) with | pinfo :: _ -> pinfo.IsFSharpEventProperty | _ -> false @@ -1346,7 +1346,7 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = | M m when m.LogicalName.StartsWith("remove_") -> let eventName = m.LogicalName.[7..] let entityTy = generalizedTyconRef m.DeclaringEntityRef - nonNil (cenv.infoReader.GetImmediateIntrinsicEventsOfType (Some eventName, AccessibleFromSomeFSharpCode, range0, entityTy)) || + not (List.isEmpty (cenv.infoReader.GetImmediateIntrinsicEventsOfType (Some eventName, AccessibleFromSomeFSharpCode, range0, entityTy))) || match GetImmediateIntrinsicPropInfosOfType(Some eventName, AccessibleFromSomeFSharpCode) cenv.g cenv.amap range0 (generalizedTyconRef m.DeclaringEntityRef) with | pinfo :: _ -> pinfo.IsFSharpEventProperty | _ -> false @@ -1377,7 +1377,7 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = match d with | M m when m.LogicalName.StartsWith("get_") -> let propName = PrettyNaming.ChopPropertyName(m.LogicalName) - nonNil (GetImmediateIntrinsicPropInfosOfType(Some propName, AccessibleFromSomeFSharpCode) cenv.g cenv.amap range0 (generalizedTyconRef m.DeclaringEntityRef)) + not (List.isEmpty (GetImmediateIntrinsicPropInfosOfType(Some propName, AccessibleFromSomeFSharpCode) cenv.g cenv.amap range0 (generalizedTyconRef m.DeclaringEntityRef))) | V v -> match v.MemberInfo with | None -> false @@ -1390,7 +1390,7 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = // Look for a matching property with the right name. | M m when m.LogicalName.StartsWith("set_") -> let propName = PrettyNaming.ChopPropertyName(m.LogicalName) - nonNil (GetImmediateIntrinsicPropInfosOfType(Some propName, AccessibleFromSomeFSharpCode) cenv.g cenv.amap range0 (generalizedTyconRef m.DeclaringEntityRef)) + not (List.isEmpty (GetImmediateIntrinsicPropInfosOfType(Some propName, AccessibleFromSomeFSharpCode) cenv.g cenv.amap range0 (generalizedTyconRef m.DeclaringEntityRef))) | V v -> match v.MemberInfo with | None -> false @@ -1466,7 +1466,7 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = member __.IsActivePattern = if isUnresolved() then false else match fsharpInfo() with - | Some v -> PrettyNaming.ActivePatternInfoOfValName v.CoreDisplayName v.Range |> isSome + | Some v -> PrettyNaming.ActivePatternInfoOfValName v.CoreDisplayName v.Range |> Option.isSome | None -> false member x.CompiledName = diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index d9d6df9d45c..fdaecbb202a 100755 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -334,7 +334,7 @@ type FSharpMethodGroup( name: string, unsortedMethods: FSharpMethodGroupItem[] ) static member Create(infoReader:InfoReader,m,denv,items:Item list) = let g = infoReader.g - if isNil items then new FSharpMethodGroup("", [| |]) else + if List.isEmpty items then new FSharpMethodGroup("", [| |]) else let name = items.Head.DisplayName let getOverloadsForItem item = #if FX_ATLEAST_40 @@ -357,7 +357,7 @@ type FSharpMethodGroup( name: string, unsortedMethods: FSharpMethodGroupItem[] ) | Item.UnionCase(ucr,_) -> if not ucr.UnionCase.IsNullary then [item] else [] | Item.ExnCase(ecr) -> - if recdFieldsOfExnDefRef ecr |> nonNil then [item] else [] + if List.isEmpty (recdFieldsOfExnDefRef ecr) then [] else [item] | Item.Property(_,pinfos) -> let pinfo = List.head pinfos if pinfo.IsIndexer then [item] else [] @@ -568,7 +568,7 @@ type TypeCheckInfo |> RemoveExplicitlySuppressed g |> FilterItemsForCtors filterCtors - if nonNil items then + if not (List.isEmpty items) then if hasTextChangedSinceLastTypecheck(textSnapshotInfo, m) then NameResResult.TypecheckStaleAndTextChanged // typecheck is stale, wait for second-chance IntelliSense to bring up right result else @@ -821,9 +821,9 @@ type TypeCheckInfo let safeCheck item = try check item with _ -> false // Are we looking for items with precisely the given name? - if nonNil items && exactMatchResidueOpt.IsSome then + if not (List.isEmpty items) && exactMatchResidueOpt.IsSome then let items = items |> FilterDeclItemsByResidue exactMatchResidueOpt.Value |> List.filter safeCheck - if nonNil items then Some(items, denv, m) else None + if not (List.isEmpty items) then Some(items, denv, m) else None else // When (items = []) we must returns Some([],..) and not None // because this value is used if we want to stop further processing (e.g. let x.$ = ...) @@ -888,7 +888,7 @@ type TypeCheckInfo | None, _ -> [], None | Some(origLongIdent), Some _ -> origLongIdent, None | Some(origLongIdent), None -> - assert (nonNil origLongIdent) + assert (not (List.isEmpty origLongIdent)) // note: as above, this happens when we are called for "precise" resolution - (F1 keyword, data tip etc..) let plid, residue = List.frontAndBack origLongIdent plid, Some residue @@ -954,13 +954,13 @@ type TypeCheckInfo match nameResItems, envItems, qualItems with // First, use unfiltered name resolution items, if they're not empty - | NameResResult.Members(items, denv, m), _, _ when nonNil items -> + | NameResResult.Members(items, denv, m), _, _ when not (List.isEmpty items) -> // lookup based on name resolution results successful Some(items, denv, m) // If we have nonempty items from environment that were resolved from a type, then use them... // (that's better than the next case - here we'd return 'int' as a type) - | _, FilterRelevantItems exactMatchResidueOpt (items, denv, m), _ when nonNil items -> + | _, FilterRelevantItems exactMatchResidueOpt (items, denv, m), _ when not (List.isEmpty items) -> // lookup based on name and environment successful Some(items, denv, m) @@ -1315,7 +1315,7 @@ type TypeCheckInfo | Item.RecdField(rfinfo) -> if isFunction g rfinfo.FieldType then [item] else [] | Item.Value v -> if isFunction g v.Type then [item] else [] | Item.UnionCase(ucr,_) -> if not ucr.UnionCase.IsNullary then [item] else [] - | Item.ExnCase(ecr) -> if recdFieldsOfExnDefRef ecr |> nonNil then [item] else [] + | Item.ExnCase(ecr) -> if List.isEmpty (recdFieldsOfExnDefRef ecr) then [] else [item] | Item.Property(_,pinfos) -> let pinfo = List.head pinfos if pinfo.IsIndexer then [item] else [] diff --git a/src/ilx/EraseClosures.fs b/src/ilx/EraseClosures.fs index eee997a8a00..3c39ac0d8f8 100644 --- a/src/ilx/EraseClosures.fs +++ b/src/ilx/EraseClosures.fs @@ -179,7 +179,7 @@ let mkCallBlockForMultiValueApp cenv doTailCall (args',rty') = let mkMethSpecForClosureCall cenv (clospec: IlxClosureSpec) = let tyargsl,argtys,rstruct = stripSupportedAbstraction clospec.FormalLambdas - if nonNil tyargsl then failwith "mkMethSpecForClosureCall: internal error"; + if not (List.isEmpty tyargsl) then failwith "mkMethSpecForClosureCall: internal error"; let rty' = mkTyOfLambdas cenv rstruct let argtys' = typesOfILParamsList argtys let minst' = clospec.GenericArgs @@ -237,7 +237,7 @@ let mkCallFunc cenv allocLocal numThisGenParams tl apps = // direct calls. match stripSupportedIndirectCall apps with // Type applications: REVIEW: get rid of curried tyapps - just tuple them - | tyargs,[],_ when nonNil tyargs -> + | tyargs,[],_ when not (List.isEmpty tyargs) -> // strip again, instantiating as we go. we could do this while we count. let (revInstTyArgs, rest') = (([],apps), tyargs) ||> List.fold (fun (revArgsSoFar,cs) _ -> @@ -260,7 +260,7 @@ let mkCallFunc cenv allocLocal numThisGenParams tl apps = else instrs1 @ buildApp false loaders' rest' // Term applications - | [],args,rest when nonNil args -> + | [],args,rest when not (List.isEmpty args) -> let precall,loaders' = computePreCall fst args.Length rest loaders let isLast = (match rest with Apps_done _ -> true | _ -> false) let rty = mkTyOfApps cenv rest diff --git a/src/ilx/EraseUnions.fs b/src/ilx/EraseUnions.fs index 47bc8183206..4cae9873d59 100644 --- a/src/ilx/EraseUnions.fs +++ b/src/ilx/EraseUnions.fs @@ -941,7 +941,7 @@ let mkClassUnionDef ilg tref td cud = yield { fdef with IsInitOnly= (not isStruct && isTotallyImmutable) } ] let ctorMeths = - if (isNil selfFields && isNil tagFieldsInObject && nonNil selfMeths) + if (List.isEmpty selfFields && List.isEmpty tagFieldsInObject && not (List.isEmpty selfMeths)) || cud.cudAlternatives |> Array.forall (fun alt -> repr.RepresentAlternativeAsFreshInstancesOfRootClass (info,alt)) then [] (* no need for a second ctor in these cases *) @@ -957,7 +957,7 @@ let mkClassUnionDef ilg tref td cud = // Now initialize the constant fields wherever they are stored... let addConstFieldInit cd = - if isNil altNullaryFields then + if List.isEmpty altNullaryFields then cd else prependInstrsToClassCtor