diff --git a/.fantomasignore b/.fantomasignore index 395a314aed8..a4802164d9b 100644 --- a/.fantomasignore +++ b/.fantomasignore @@ -12,7 +12,7 @@ vsintegration/* !vsintegration/tests/FSharp.Editor.Tests artifacts/ -# For some reason, it tries to format files from remotes (Processing .\.git\refs\remotes\\FSComp.fsi) +# For some reason, it tries to format files from remotes (Processing ./.git/refs/remotes//FSComp.fsi) .git/ # Explicitly unformatted implementation @@ -101,10 +101,22 @@ src/FSharp.Core/option.fsi src/FSharp.Core/option.fs src/fsi/console.fs src/FSharp.Build/FSharpCommandLineBuilder.fs + +src/Compiler/Utilities/Activity.fs src/Compiler/Utilities/sformat.fs src/Compiler/Utilities/illib.fsi src/Compiler/Utilities/illib.fs + +src/Compiler/Utilities/NullnessShims.fs +src/Compiler/Utilities/LruCache.fsi +src/Compiler/Utilities/LruCache.fs +src/Compiler/Utilities/HashMultiMap.fsi +src/Compiler/Utilities/HashMultiMap.fs +src/Compiler/Facilities/AsyncMemoize.fsi +src/Compiler/Facilities/AsyncMemoize.fs +src/Compiler/AbstractIL/il.fs + # Fantomas limitations on implementation files (to investigate) src/Compiler/AbstractIL/ilwrite.fs diff --git a/FSharpBuild.Directory.Build.targets b/FSharpBuild.Directory.Build.targets index d49de27dccc..9ec79ae78c8 100644 --- a/FSharpBuild.Directory.Build.targets +++ b/FSharpBuild.Directory.Build.targets @@ -88,6 +88,14 @@ + + + $(ProtoOutputPath)\fsc\FSharp.Build.dll + + + + + (keyf: 'Data -> 'Key, lazyItems: InterruptibleLazy<'Data list>) = +type LazyOrderedMultiMap<'Key, 'Data when 'Key: equality +#if !NO_CHECKNULLS + and 'Key:not null +#endif + >(keyf: 'Data -> 'Key, lazyItems: InterruptibleLazy<'Data list>) = let quickMap = lazyItems @@ -515,7 +519,8 @@ type ILAssemblyRef(data) = let retargetable = aname.Flags = AssemblyNameFlags.Retargetable - ILAssemblyRef.Create(aname.Name, None, publicKey, retargetable, version, locale) + let name = match aname.Name with | null -> aname.FullName | name -> name + ILAssemblyRef.Create(name, None, publicKey, retargetable, version, locale) member aref.QualifiedName = let b = StringBuilder(100) @@ -823,7 +828,7 @@ type ILTypeRef = member x.DebugText = x.ToString() /// For debugging - override x.ToString() = x.FullName + override x.ToString() : string = x.FullName and [] ILTypeSpec = { @@ -875,7 +880,7 @@ and [" + x.TypeRef.FullName + if isNil x.GenericArgs then "" else "<...>" and [] ILType = | Void @@ -1017,8 +1022,9 @@ type ILMethodRef = [] member x.DebugText = x.ToString() - override x.ToString() = - x.DeclaringTypeRef.ToString() + "::" + x.Name + "(...)" + member x.FullName = x.DeclaringTypeRef.FullName + "::" + x.Name + "(...)" + + override x.ToString() = x.FullName [] type ILFieldRef = @@ -1033,7 +1039,7 @@ type ILFieldRef = member x.DebugText = x.ToString() override x.ToString() = - x.DeclaringTypeRef.ToString() + "::" + x.Name + x.DeclaringTypeRef.FullName + "::" + x.Name [] type ILMethodSpec = @@ -1072,7 +1078,7 @@ type ILMethodSpec = [] member x.DebugText = x.ToString() - override x.ToString() = x.MethodRef.ToString() + "(...)" + override x.ToString() = x.MethodRef.FullName + "(...)" [] type ILFieldSpec = @@ -1213,7 +1219,7 @@ type ILAttribute = [] member x.DebugText = x.ToString() - override x.ToString() = x.Method.ToString() + "(...)" + override x.ToString() = x.Method.MethodRef.FullName [] type ILAttributes(array: ILAttribute[]) = @@ -1571,7 +1577,7 @@ type ILFieldInit = | ILFieldInit.UInt64 u64 -> box u64 | ILFieldInit.Single ieee32 -> box ieee32 | ILFieldInit.Double ieee64 -> box ieee64 - | ILFieldInit.Null -> (null :> Object) + | ILFieldInit.Null -> (null :> objnull) // -------------------------------------------------------------------- // Native Types, for marshalling to the native C interface. diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index a89b343f9ea..bb383e32ba1 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -237,6 +237,8 @@ type ILTypeRef = member internal EqualsWithPrimaryScopeRef: ILScopeRef * obj -> bool + override ToString: unit -> string + interface System.IComparable /// Type specs and types. @@ -664,7 +666,7 @@ type ILFieldInit = | Double of double | Null - member AsObject: unit -> obj + member AsObject: unit -> objnull [] type internal ILNativeVariant = diff --git a/src/Compiler/AbstractIL/ilnativeres.fs b/src/Compiler/AbstractIL/ilnativeres.fs index 0d0b6a1c986..ec6a928fc63 100644 --- a/src/Compiler/AbstractIL/ilnativeres.fs +++ b/src/Compiler/AbstractIL/ilnativeres.fs @@ -1000,7 +1000,7 @@ type Directory(name, id) = member val ID = id member val NumberOfNamedEntries = Unchecked.defaultof with get, set member val NumberOfIdEntries = Unchecked.defaultof with get, set - member val Entries = List() + member val Entries = List() type NativeResourceWriter() = static member private CompareResources (left: Win32Resource) (right: Win32Resource) = @@ -1149,7 +1149,12 @@ type NativeResourceWriter() = dataWriter.WriteByte 0uy false - | e -> failwithf "Unknown entry %s" (if isNull e then "" else e.GetType().FullName) + | e -> + failwithf + "Unknown entry %s" + (match e with + | null -> "" + | e -> e.GetType().FullName) if id >= 0 then writer.WriteInt32 id diff --git a/src/Compiler/AbstractIL/ilpars.fsy b/src/Compiler/AbstractIL/ilpars.fsy index 67c8e4d1fe3..4fb93db65c4 100644 --- a/src/Compiler/AbstractIL/ilpars.fsy +++ b/src/Compiler/AbstractIL/ilpars.fsy @@ -3,6 +3,7 @@ %{ #nowarn "1182" // the generated code often has unused variable "parseState" +#nowarn "3261" // the generated code would need to properly annotate nulls, e.g. changing System.Object to `obj|null` open Internal.Utilities.Library diff --git a/src/Compiler/AbstractIL/ilread.fs b/src/Compiler/AbstractIL/ilread.fs index 7628df6311b..14b2de49f85 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -941,11 +941,11 @@ let mkCacheGeneric lowMem _inbase _nm (sz: int) = fun f (idx: 'T) -> let cache = match cache with - | Null -> + | null -> let v = ConcurrentDictionary<_, _>(Environment.ProcessorCount, sz) cache <- v v - | NonNull v -> v + | v -> v match cache.TryGetValue idx with | true, v -> diff --git a/src/Compiler/AbstractIL/ilreflect.fs b/src/Compiler/AbstractIL/ilreflect.fs index 748ecafda21..3ccb7c0e1d6 100644 --- a/src/Compiler/AbstractIL/ilreflect.fs +++ b/src/Compiler/AbstractIL/ilreflect.fs @@ -163,7 +163,12 @@ type TypeBuilder with if logRefEmitCalls then printfn "typeBuilder%d.CreateType()" (abs <| hash typB) + //Buggy annotation in ns20, will not be fixed. +#if NETSTANDARD && !NO_CHECKNULLS + !!(typB.CreateTypeInfo()) :> Type +#else typB.CreateTypeInfo() :> Type +#endif member typB.DefineNestedTypeAndLog(name, attrs) = let res = typB.DefineNestedType(name, attrs) @@ -270,10 +275,9 @@ type TypeBuilder with else null - if not (isNull m) then - m.Invoke(null, args) - else - raise (MissingMethodException nm) + match m with + | null -> raise (MissingMethodException nm) + | m -> m.Invoke(null, args) member typB.SetCustomAttributeAndLog(cinfo, bytes) = if logRefEmitCalls then @@ -284,9 +288,12 @@ type TypeBuilder with type OpCode with member opcode.RefEmitName = - (string (Char.ToUpper(opcode.Name[0])) + opcode.Name[1..]) - .Replace(".", "_") - .Replace("_i4", "_I4") + match opcode.Name with + | null -> "" + | name -> + (string (Char.ToUpper(name[0])) + name[1..]) + .Replace(".", "_") + .Replace("_i4", "_I4") type ILGenerator with @@ -320,7 +327,7 @@ type ILGenerator with ilG.BeginFinallyBlock() - member ilG.BeginCatchBlockAndLog ty = + member ilG.BeginCatchBlockAndLog(ty: Type) = if logRefEmitCalls then printfn "ilg%d.BeginCatchBlock(%A)" (abs <| hash ilG) ty @@ -396,7 +403,7 @@ type ILGenerator with member x.EmitAndLog(op: OpCode, v: ConstructorInfo) = if logRefEmitCalls then - printfn "ilg%d.Emit(OpCodes.%s, constructor_%s)" (abs <| hash x) op.RefEmitName v.DeclaringType.Name + printfn "ilg%d.Emit(OpCodes.%s, constructor_%s)" (abs <| hash x) op.RefEmitName (!!v.DeclaringType).Name x.Emit(op, v) @@ -693,7 +700,7 @@ let rec convTypeSpec cenv emEnv preferCreated (tspec: ILTypeSpec) = let typT = convTypeRef cenv emEnv preferCreated tspec.TypeRef let tyargs = List.map (convTypeAux cenv emEnv preferCreated) tspec.GenericArgs - let res = + let res: Type MaybeNull = match isNil tyargs, typT.IsGenericType with | _, true -> typT.MakeGenericType(List.toArray tyargs) | true, false -> typT @@ -706,7 +713,7 @@ let rec convTypeSpec cenv emEnv preferCreated (tspec: ILTypeSpec) = and convTypeAux cenv emEnv preferCreated ty = match ty with - | ILType.Void -> Type.GetType("System.Void") + | ILType.Void -> !! Type.GetType("System.Void") | ILType.Array(shape, eltType) -> let baseT = convTypeAux cenv emEnv preferCreated eltType let nDims = shape.Rank @@ -844,26 +851,10 @@ let queryableTypeGetField _emEnv (parentT: Type) (fref: ILFieldRef) = | NonNull res -> res let nonQueryableTypeGetField (parentTI: Type) (fieldInfo: FieldInfo) : FieldInfo = - let res = - if parentTI.IsGenericType then - TypeBuilder.GetField(parentTI, fieldInfo) - else - fieldInfo - - match res with - | Null -> - error ( - Error( - FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen ( - "field", - fieldInfo.Name, - parentTI.AssemblyQualifiedName, - parentTI.Assembly.FullName - ), - range0 - ) - ) - | NonNull res -> res + if parentTI.IsGenericType then + TypeBuilder.GetField(parentTI, fieldInfo) + else + fieldInfo let convFieldSpec cenv emEnv fspec = let fref = fspec.FieldRef @@ -1012,21 +1003,16 @@ let queryableTypeGetMethod cenv emEnv parentT (mref: ILMethodRef) : MethodInfo = let methInfo = try - parentT.GetMethod( - mref.Name, - cconv ||| BindingFlags.Public ||| BindingFlags.NonPublic, - null, - argTs, - (null: ParameterModifier[] MaybeNull) - ) + parentT.GetMethod(mref.Name, cconv ||| BindingFlags.Public ||| BindingFlags.NonPublic, null, argTs, null) // This can fail if there is an ambiguity w.r.t. return type with _ -> null - if (isNotNull methInfo && equalTypes resT methInfo.ReturnType) then - methInfo - else - queryableTypeGetMethodBySearch cenv emEnv parentT mref + match methInfo with + | null -> queryableTypeGetMethodBySearch cenv emEnv parentT mref + | m when equalTypes resT m.ReturnType -> m + | _ -> queryableTypeGetMethodBySearch cenv emEnv parentT mref + else queryableTypeGetMethodBySearch cenv emEnv parentT mref @@ -1062,7 +1048,12 @@ let convMethodRef cenv emEnv (parentTI: Type) (mref: ILMethodRef) = | Null -> error ( Error( - FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen ("method", mref.Name, parentTI.FullName, parentTI.Assembly.FullName), + FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen ( + "method", + mref.Name, + parentTI.FullName |> string, + parentTI.Assembly.FullName |> string + ), range0 ) ) @@ -1103,7 +1094,12 @@ let queryableTypeGetConstructor cenv emEnv (parentT: Type) (mref: ILMethodRef) = | Null -> error ( Error( - FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen ("constructor", mref.Name, parentT.FullName, parentT.Assembly.FullName), + FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen ( + "constructor", + mref.Name, + parentT.FullName |> string, + parentT.Assembly.FullName |> string + ), range0 ) ) @@ -1138,7 +1134,12 @@ let convConstructorSpec cenv emEnv (mspec: ILMethodSpec) = | Null -> error ( Error( - FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen ("constructor", "", parentTI.FullName, parentTI.Assembly.FullName), + FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen ( + "constructor", + "", + parentTI.FullName |> string, + parentTI.Assembly.FullName |> string + ), range0 ) ) @@ -1490,7 +1491,7 @@ let rec emitInstr cenv (modB: ModuleBuilder) emEnv (ilG: ILGenerator) instr = ilG.EmitAndLog(OpCodes.Ldelema, convType cenv emEnv ty) else let arrayTy = convType cenv emEnv (ILType.Array(shape, ty)) - let elemTy = arrayTy.GetElementType() + let elemTy = !! arrayTy.GetElementType() let argTys = Array.create shape.Rank typeof let retTy = elemTy.MakeByRefType() @@ -1516,7 +1517,7 @@ let rec emitInstr cenv (modB: ModuleBuilder) emEnv (ilG: ILGenerator) instr = ilG.EmitAndLog(OpCodes.Stelem, convType cenv emEnv ty) else let arrayTy = convType cenv emEnv (ILType.Array(shape, ty)) - let elemTy = arrayTy.GetElementType() + let elemTy = !! arrayTy.GetElementType() let meth = modB.GetArrayMethodAndLog( @@ -1624,7 +1625,7 @@ let emitCode cenv modB emEnv (ilG: ILGenerator) (code: ILCode) = | ILExceptionClause.FilterCatch((startFilter, _), (startHandler, endHandler)) -> add startFilter ilG.BeginExceptFilterBlockAndLog - add startHandler (fun () -> ilG.BeginCatchBlockAndLog null) + add startHandler (fun () -> ilG.BeginCatchBlockAndLog Unchecked.defaultof<_>) add endHandler ilG.EndExceptionBlockAndLog | ILExceptionClause.TypeCatch(ty, (startHandler, endHandler)) -> @@ -1830,24 +1831,25 @@ let rec buildMethodPass2 cenv tref (typB: TypeBuilder) emEnv (mdef: ILMethodDef) let methB = System.Diagnostics.Debug.Assert(not (isNull definePInvokeMethod), "Runtime does not have DefinePInvokeMethod") // Absolutely can't happen - definePInvokeMethod.Invoke( - typB, - [| - mdef.Name - p.Where.Name - p.Name - attrs - cconv - retTy - null - null - argTys - null - null - pcc - pcs - |] - ) + (!!definePInvokeMethod) + .Invoke( + typB, + [| + mdef.Name + p.Where.Name + p.Name + attrs + cconv + retTy + null + null + argTys + null + null + pcc + pcs + |] + ) :?> MethodBuilder methB.SetImplementationFlagsAndLog implflags @@ -2473,7 +2475,7 @@ let defineDynamicAssemblyAndLog (asmName, flags, asmDir: string) = asmB -let mkDynamicAssemblyAndModule (assemblyName, optimize, collectible) = +let mkDynamicAssemblyAndModule (assemblyName: string, optimize, collectible) = let asmDir = "." let asmName = AssemblyName() asmName.Name <- assemblyName @@ -2490,7 +2492,7 @@ let mkDynamicAssemblyAndModule (assemblyName, optimize, collectible) = let daType = typeof let daCtor = - daType.GetConstructor [| typeof |] + !! daType.GetConstructor([| typeof |]) let daBuilder = CustomAttributeBuilder( diff --git a/src/Compiler/AbstractIL/ilsign.fs b/src/Compiler/AbstractIL/ilsign.fs index 7a383d4a079..8c50c93a7bf 100644 --- a/src/Compiler/AbstractIL/ilsign.fs +++ b/src/Compiler/AbstractIL/ilsign.fs @@ -64,7 +64,9 @@ let hashAssembly (peReader: PEReader) (hashAlgorithm: IncrementalHash) = let checkSumOffset = peHeaderOffset + 0x40 // offsetof(IMAGE_OPTIONAL_HEADER, CheckSum) let securityDirectoryEntryOffset, peHeaderSize = - match peHeaders.PEHeader.Magic with + let header = peHeaders.PEHeader |> nullArgCheck (nameof peHeaders.PEHeader) + + match header.Magic with | PEMagic.PE32 -> peHeaderOffset + 0x80, 0xE0 // offsetof(IMAGE_OPTIONAL_HEADER32, DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY]), sizeof(IMAGE_OPTIONAL_HEADER32) | PEMagic.PE32Plus -> peHeaderOffset + 0x90, 0xF0 // offsetof(IMAGE_OPTIONAL_HEADER64, DataDirectory[IMAGE_DIRECTORY_ENTRY_SECURITY]), sizeof(IMAGE_OPTIONAL_HEADER64) | _ -> raise (BadImageFormatException(getResourceString (FSComp.SR.ilSignInvalidMagicValue ()))) @@ -87,7 +89,9 @@ let hashAssembly (peReader: PEReader) (hashAlgorithm: IncrementalHash) = hashAlgorithm.AppendData(allHeaders, 0, allHeadersSize) // Hash content of all sections - let signatureDirectory = peHeaders.CorHeader.StrongNameSignatureDirectory + let signatureDirectory = + let corHeader = peHeaders.CorHeader |> nullArgCheck (nameof peHeaders.CorHeader) + corHeader.StrongNameSignatureDirectory let signatureStart = match peHeaders.TryGetDirectoryOffset signatureDirectory with @@ -186,10 +190,10 @@ let toCLRKeyBlob (rsaParameters: RSAParameters) (algId: int) : byte array = if isNull rsaParameters.Modulus then raise (CryptographicException(String.Format(getResourceString (FSComp.SR.ilSignInvalidRSAParams ()), "Modulus"))) - if isNull rsaParameters.Exponent || rsaParameters.Exponent.Length > 4 then + if isNull rsaParameters.Exponent || (!!rsaParameters.Exponent).Length > 4 then raise (CryptographicException(String.Format(getResourceString (FSComp.SR.ilSignInvalidRSAParams ()), "Exponent"))) - let modulusLength = rsaParameters.Modulus.Length + let modulusLength = (!!rsaParameters.Modulus).Length let halfModulusLength = (modulusLength + 1) / 2 // We assume that if P != null, then so are Q, DP, DQ, InverseQ and D and indicate KeyPair RSA Parameters @@ -227,29 +231,37 @@ let toCLRKeyBlob (rsaParameters: RSAParameters) (algId: int) : byte array = let expAsDword = let mutable buffer = int 0 - for i in 0 .. rsaParameters.Exponent.Length - 1 do - buffer <- (buffer <<< 8) ||| int rsaParameters.Exponent[i] + match rsaParameters.Exponent with + | null -> () + | exp -> + for i in 0 .. exp.Length - 1 do + buffer <- (buffer <<< 8) ||| int exp[i] buffer + let safeArrayRev (buffer: _ MaybeNull) = + match buffer with + | Null -> Array.empty + | NonNull buffer -> buffer |> Array.rev + bw.Write expAsDword // RSAPubKey.pubExp - bw.Write(rsaParameters.Modulus |> Array.rev) // Copy over the modulus for both public and private + bw.Write(rsaParameters.Modulus |> safeArrayRev) // Copy over the modulus for both public and private if isPrivate then do - bw.Write(rsaParameters.P |> Array.rev) - bw.Write(rsaParameters.Q |> Array.rev) - bw.Write(rsaParameters.DP |> Array.rev) - bw.Write(rsaParameters.DQ |> Array.rev) - bw.Write(rsaParameters.InverseQ |> Array.rev) - bw.Write(rsaParameters.D |> Array.rev) + bw.Write(rsaParameters.P |> safeArrayRev) + bw.Write(rsaParameters.Q |> safeArrayRev) + bw.Write(rsaParameters.DP |> safeArrayRev) + bw.Write(rsaParameters.DQ |> safeArrayRev) + bw.Write(rsaParameters.InverseQ |> safeArrayRev) + bw.Write(rsaParameters.D |> safeArrayRev) bw.Flush() ms.ToArray() key -let createSignature hash keyBlob keyType = +let createSignature (hash: byte array) keyBlob keyType = use rsa = RSA.Create() rsa.ImportParameters(RSAParamatersFromBlob keyBlob keyType) @@ -260,7 +272,8 @@ let createSignature hash keyBlob keyType = let patchSignature (stream: Stream) (peReader: PEReader) (signature: byte array) = let peHeaders = peReader.PEHeaders - let signatureDirectory = peHeaders.CorHeader.StrongNameSignatureDirectory + let corHeader = peHeaders.CorHeader |> nullArgCheck (nameof peHeaders.CorHeader) + let signatureDirectory = corHeader.StrongNameSignatureDirectory let signatureOffset = if signatureDirectory.Size > signature.Length then @@ -275,7 +288,7 @@ let patchSignature (stream: Stream) (peReader: PEReader) (signature: byte array) let corHeaderFlagsOffset = int64 (peHeaders.CorHeaderStartOffset + 16) // offsetof(IMAGE_COR20_HEADER, Flags) stream.Seek(corHeaderFlagsOffset, SeekOrigin.Begin) |> ignore - stream.WriteByte(byte (peHeaders.CorHeader.Flags ||| CorFlags.StrongNameSigned)) + stream.WriteByte(byte (corHeader.Flags ||| CorFlags.StrongNameSigned)) () let signStream stream keyBlob = diff --git a/src/Compiler/AbstractIL/ilwrite.fs b/src/Compiler/AbstractIL/ilwrite.fs index c4c43f6a5fc..2346560dc3a 100644 --- a/src/Compiler/AbstractIL/ilwrite.fs +++ b/src/Compiler/AbstractIL/ilwrite.fs @@ -362,7 +362,11 @@ let envForOverrideSpec (ospec: ILOverridesSpec) = { EnclosingTyparCount=ospec.De //--------------------------------------------------------------------- [] -type MetadataTable<'T> = +type MetadataTable<'T +#if !NO_CHECKNULLS + when 'T:not null +#endif + > = { name: string dict: Dictionary<'T, int> // given a row, find its entry number mutable rows: ResizeArray<'T> } diff --git a/src/Compiler/AbstractIL/ilwritepdb.fs b/src/Compiler/AbstractIL/ilwritepdb.fs index fd5ffad27ac..f7d4f9a0962 100644 --- a/src/Compiler/AbstractIL/ilwritepdb.fs +++ b/src/Compiler/AbstractIL/ilwritepdb.fs @@ -343,10 +343,7 @@ let scopeSorter (scope1: PdbMethodScope) (scope2: PdbMethodScope) = type PortablePdbGenerator (embedAllSource: bool, embedSourceList: string list, sourceLink: string, checksumAlgorithm, info: PdbData, pathMap: PathMap) = - let docs = - match info.Documents with - | Null -> Array.empty - | NonNull docs -> docs + let docs = info.Documents // The metadata to wite to the PoortablePDB (Roslyn = _debugMetadataOpt) @@ -393,7 +390,7 @@ type PortablePdbGenerator /// let sourceCompressionThreshold = 200 - let includeSource file = + let includeSource (file: string) = let isInList = embedSourceList |> List.exists (fun f -> String.Compare(file, f, StringComparison.OrdinalIgnoreCase) = 0) @@ -654,12 +651,9 @@ type PortablePdbGenerator let emitMethod minfo = let docHandle, sequencePointBlob = let sps = - match minfo.DebugPoints with - | Null -> Array.empty - | NonNull pts -> - match minfo.DebugRange with - | None -> Array.empty - | Some _ -> pts + match minfo.DebugRange with + | None -> Array.empty + | Some _ -> minfo.DebugPoints let builder = BlobBuilder() builder.WriteCompressedInteger(minfo.LocalSignatureToken) @@ -872,7 +866,7 @@ let getInfoForEmbeddedPortablePdb (uncompressedLength: int64) (contentId: BlobContentId) (compressedStream: MemoryStream) - pdbfile + (pdbfile: string) cvChunk pdbChunk deterministicPdbChunk @@ -886,7 +880,7 @@ let getInfoForEmbeddedPortablePdb pdbGetDebugInfo (contentId.Guid.ToByteArray()) (int32 contentId.Stamp) - fn + !!fn cvChunk (Some pdbChunk) deterministicPdbChunk diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index d550aaccba4..1dd832ebb3e 100644 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -380,7 +380,7 @@ let CheckFSharpAttributesForUnseen g attribs _m = #if !NO_TYPEPROVIDERS /// Indicate if a list of provided attributes contains 'ObsoleteAttribute'. Used to suppress the item in intellisense. let CheckProvidedAttributesForUnseen (provAttribs: Tainted) m = - provAttribs.PUntaint((fun a -> a.GetAttributeConstructorArgs(provAttribs.TypeProvider.PUntaintNoFailure(id), typeof.FullName).IsSome), m) + provAttribs.PUntaint((fun a -> a.GetAttributeConstructorArgs(provAttribs.TypeProvider.PUntaintNoFailure(id), !! typeof.FullName).IsSome), m) #endif /// Check the attributes associated with a property, returning warnings and errors as data. @@ -479,7 +479,7 @@ let MethInfoIsUnseen g (m: range) (ty: TType) minfo = // just to look at the attributes on IL methods. if tcref.IsILTycon then tcref.ILTyconRawMetadata.CustomAttrs.AsArray() - |> Array.exists (fun attr -> attr.Method.DeclaringType.TypeSpec.Name = typeof.FullName) + |> Array.exists (fun attr -> attr.Method.DeclaringType.TypeSpec.Name = !! typeof.FullName) else false #else diff --git a/src/Compiler/Checking/CheckFormatStrings.fs b/src/Compiler/Checking/CheckFormatStrings.fs index 1264cbbcb86..e0555ef2a79 100644 --- a/src/Compiler/Checking/CheckFormatStrings.fs +++ b/src/Compiler/Checking/CheckFormatStrings.fs @@ -359,10 +359,10 @@ let parseFormatStringInternal let acc = if widthArg then (Option.map ((+)1) posi, g.int_ty) :: acc else acc let checkOtherFlags c = - if info.precision then failwith (FSComp.SR.forFormatDoesntSupportPrecision(c.ToString())) - if info.addZeros then failwith (FSComp.SR.forDoesNotSupportZeroFlag(c.ToString())) + if info.precision then failwith (FSComp.SR.forFormatDoesntSupportPrecision(c.ToString() |> string)) + if info.addZeros then failwith (FSComp.SR.forDoesNotSupportZeroFlag(c.ToString() |> string)) match info.numPrefixIfPos with - | Some n -> failwith (FSComp.SR.forDoesNotSupportPrefixFlag(c.ToString(), n.ToString())) + | Some n -> failwith (FSComp.SR.forDoesNotSupportPrefixFlag(c.ToString() |> string, n.ToString())) | None -> () let skipPossibleInterpolationHole pos = Parse.skipPossibleInterpolationHole isInterpolated isFormattableString fmt pos diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index e1ed518f2d3..a87536a07a2 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -655,8 +655,8 @@ and TcPatLongIdentUnionCaseOrExnCase warnOnUpper cenv env ad vFlags patEnv ty (m CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, argItem, emptyTyparInst, ItemOccurence.Pattern, ad) match box result[idx] with - | Null -> result[idx] <- pat - | NonNull _ -> + | null -> result[idx] <- pat + | _ -> extraPatterns.Add pat errorR (Error (FSComp.SR.tcUnionCaseFieldCannotBeUsedMoreThanOnce id.idText, id.idRange)) diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 132f8b01df4..8789e92797c 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -4913,8 +4913,8 @@ and CrackStaticConstantArgs (cenv: cenv) env tpenv (staticParameters: Tainted if sp.PUntaint((fun sp -> sp.IsOptional), m) then match sp.PUntaint((fun sp -> sp.RawDefaultValue), m) with - | Null -> error (Error(FSComp.SR.etStaticParameterRequiresAValue (spName, containerName, containerName, spName), m)) - | NonNull v -> v + | null -> error (Error(FSComp.SR.etStaticParameterRequiresAValue (spName, containerName, containerName, spName), m)) + | v -> v else error (Error(FSComp.SR.etStaticParameterRequiresAValue (spName, containerName, containerName, spName), m)) | ps -> diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index 1d085c195da..26b7d25c843 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/src/Compiler/Checking/InfoReader.fs @@ -731,25 +731,28 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = // Only cache closed, monomorphic types (closed = all members for the type // have been processed). Generic type instantiations could be processed if we had // a decent hash function for these. + + // Nullness of `ty` (TType_app) is not considered here, as the info is used to load members of the type + // It would matter for different generic instantiations of the same type, but we don't cache that here - TType_app is always matched for `[]` typars. canMemoize=(fun (_flags, _: range, ty) -> match stripTyEqns g ty with - | TType_app(tcref, [], _) -> tcref.TypeContents.tcaug_closed // TODO NULLNESS: consider whether ignoring _nullness is valid here + | TType_app(tcref, [], _) -> tcref.TypeContents.tcaug_closed | _ -> false), keyComparer= { new IEqualityComparer<_> with - member _.Equals((flags1, _, ty1), (flags2, _, ty2)) = - // Ignoring the ranges - that's OK. - flagsEq.Equals(flags1, flags2) && - match stripTyEqns g ty1, stripTyEqns g ty2 with - | TType_app(tcref1, [], _),TType_app(tcref2, [], _) -> tyconRefEq g tcref1 tcref2 // TODO NULLNESS: consider whether ignoring _nullness is valid here - | _ -> false member _.GetHashCode((flags, _, ty)) = // Ignoring the ranges - that's OK. flagsEq.GetHashCode flags + (match stripTyEqns g ty with - | TType_app(tcref, [], _) -> hash tcref.LogicalName // TODO NULLNESS: consider whether ignoring _nullness is valid here - | _ -> 0) }) + | TType_app(tcref, [], _) -> hash tcref.LogicalName + | _ -> 0) + member _.Equals((flags1, _, ty1), (flags2, _, ty2)) = + // Ignoring the ranges - that's OK. + flagsEq.Equals(flags1, flags2) && + match stripTyEqns g ty1, stripTyEqns g ty2 with + | TType_app(tcref1, [], _),TType_app(tcref2, [], _) -> tyconRefEq g tcref1 tcref2 + | _ -> false }) let FindImplicitConversionsUncached (ad, m, ty) = if isTyparTy g ty then @@ -791,7 +794,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = let hashFlags3 = { new IEqualityComparer with member _.GetHashCode((ad: AccessorDomain)) = AccessorDomain.CustomGetHashCode ad - member _.Equals((ad1), (ad2)) = AccessorDomain.CustomEquals(g, ad1, ad2) } + member _.Equals((ad1), (ad2)) = nullSafeEquality ad1 ad2 (fun ad1 ad2 -> AccessorDomain.CustomEquals(g, ad1, ad2)) } let hashFlags4 = { new IEqualityComparer with diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index f75fd2fb6be..878c5099573 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -1727,7 +1727,7 @@ let AdjustCallerArgs tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader // This file is not a great place for this functionality to sit, it's here because of BuildMethodCall module ProvidedMethodCalls = - let private convertConstExpr g amap m (constant : Tainted) = + let private convertConstExpr g amap m (constant : Tainted) = let obj, objTy = constant.PApply2(id, m) let ty = Import.ImportProvidedType amap m objTy let normTy = normalizeEnumTy g ty diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index ba45fc52411..f1945c80928 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -4296,7 +4296,7 @@ let ItemOfTy g x = Item.Types (nm, [x]) // Filter out 'PrivateImplementationDetail' classes -let IsInterestingModuleName nm = not (System.String.IsNullOrEmpty nm) && nm[0] <> '<' +let IsInterestingModuleName nm = not (System.String.IsNullOrEmpty nm) && (!!nm)[0] <> '<' let rec PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThen f plid (modref: ModuleOrNamespaceRef) = let mty = modref.ModuleOrNamespaceType diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index 0d0d8695227..f954e38b6fd 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -263,7 +263,7 @@ module internal PrintUtilities = if possibleXmlDoc.IsEmpty then match info with | Some(Some ccuFileName, xmlDocSig) -> - infoReader.amap.assemblyLoader.TryFindXmlDocumentationInfo(Path.GetFileNameWithoutExtension ccuFileName) + infoReader.amap.assemblyLoader.TryFindXmlDocumentationInfo(!!Path.GetFileNameWithoutExtension(ccuFileName)) |> Option.bind (fun xmlDocInfo -> xmlDocInfo.TryGetXmlDocBySig(xmlDocSig) ) @@ -2913,7 +2913,7 @@ let minimalStringsOfTwoTypes denv ty1 ty2 = let denv = denv.SetOpenPaths [] let denv = { denv with includeStaticParametersInTypeNames=true } let makeName t = - let assemblyName = PrintTypes.layoutAssemblyName denv t |> function null | "" -> "" | name -> sprintf " (%s)" name + let assemblyName = PrintTypes.layoutAssemblyName denv t |> function Null | NonNull "" -> "" | NonNull name -> sprintf " (%s)" name sprintf "%s%s" (stringOfTy denv t) assemblyName (makeName ty1, makeName ty2, stringOfTyparConstraints denv tpcs) diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index c57eefdc329..fd7a3189e0d 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -2345,25 +2345,25 @@ let CheckEntityDefn cenv env (tycon: Entity) = ignore isInArg match (optArgInfo, callerInfo) with | _, NoCallerInfo -> () - | NotOptional, _ -> errorR(Error(FSComp.SR.tcCallerInfoNotOptional(callerInfo.ToString()), m)) + | NotOptional, _ -> errorR(Error(FSComp.SR.tcCallerInfoNotOptional(callerInfo |> string), m)) | CallerSide _, CallerLineNumber -> if not (typeEquiv g g.int32_ty ty) then - errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "int", NicePrint.minimalStringOfType cenv.denv ty), m)) + errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo |> string, "int", NicePrint.minimalStringOfType cenv.denv ty), m)) | CalleeSide, CallerLineNumber -> if not ((isOptionTy g ty) && (typeEquiv g g.int32_ty (destOptionTy g ty))) then - errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "int", NicePrint.minimalStringOfType cenv.denv (destOptionTy g ty)), m)) + errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo |> string, "int", NicePrint.minimalStringOfType cenv.denv (destOptionTy g ty)), m)) | CallerSide _, CallerFilePath -> if not (typeEquiv g g.string_ty ty) then - errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "string", NicePrint.minimalStringOfType cenv.denv ty), m)) + errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo |> string, "string", NicePrint.minimalStringOfType cenv.denv ty), m)) | CalleeSide, CallerFilePath -> if not ((isOptionTy g ty) && (typeEquiv g g.string_ty (destOptionTy g ty))) then - errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "string", NicePrint.minimalStringOfType cenv.denv (destOptionTy g ty)), m)) + errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo |> string, "string", NicePrint.minimalStringOfType cenv.denv (destOptionTy g ty)), m)) | CallerSide _, CallerMemberName -> if not (typeEquiv g g.string_ty ty) then - errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "string", NicePrint.minimalStringOfType cenv.denv ty), m)) + errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo |> string, "string", NicePrint.minimalStringOfType cenv.denv ty), m)) | CalleeSide, CallerMemberName -> if not ((isOptionTy g ty) && (typeEquiv g g.string_ty (destOptionTy g ty))) then - errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "string", NicePrint.minimalStringOfType cenv.denv (destOptionTy g ty)), m))) + errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo |> string, "string", NicePrint.minimalStringOfType cenv.denv (destOptionTy g ty)), m))) for pinfo in immediateProps do let nm = pinfo.PropertyName diff --git a/src/Compiler/Checking/TypeHierarchy.fs b/src/Compiler/Checking/TypeHierarchy.fs index 1ab418c276a..a4f75581c29 100644 --- a/src/Compiler/Checking/TypeHierarchy.fs +++ b/src/Compiler/Checking/TypeHierarchy.fs @@ -47,7 +47,7 @@ let GetSuperTypeOfType g amap m ty = #if !NO_TYPEPROVIDERS | ProvidedTypeMetadata info -> let st = info.ProvidedType - let superOpt = st.PApplyOption((fun st -> match st.BaseType with null -> None | t -> Some (nonNull t)), m) + let superOpt = st.PApplyOption((fun st -> match st.BaseType with null -> None | t -> Some t), m) match superOpt with | None -> None | Some super -> Some(ImportProvidedType amap m super) diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index 55c737c6917..74dc1c437fd 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -344,12 +344,12 @@ let CrackParamAttribsInfo g (ty: TType, argInfo: ArgReprInfo) = type ILFieldInit with /// Compute the ILFieldInit for the given provided constant value for a provided enum type. - static member FromProvidedObj m (v: obj) = + static member FromProvidedObj m (v: obj MaybeNull) = match v with | Null -> ILFieldInit.Null | NonNull v -> let objTy = v.GetType() - let v = if objTy.IsEnum then objTy.GetField("value__").GetValue v else v + let v = if objTy.IsEnum then !!(!!objTy.GetField("value__")).GetValue v else v match v with | :? single as i -> ILFieldInit.Single i | :? double as i -> ILFieldInit.Double i @@ -364,7 +364,7 @@ type ILFieldInit with | :? uint32 as i -> ILFieldInit.UInt32 i | :? int64 as i -> ILFieldInit.Int64 i | :? uint64 as i -> ILFieldInit.UInt64 i - | _ -> error(Error(FSComp.SR.infosInvalidProvidedLiteralValue(try v.ToString() with _ -> "?"), m)) + | _ -> error(Error(FSComp.SR.infosInvalidProvidedLiteralValue(try !!v.ToString() with _ -> "?"), m)) /// Compute the OptionalArgInfo for a provided parameter. @@ -1259,10 +1259,10 @@ type MethInfo = | ProvidedMeth(amap, mi, _, _) -> // A single group of tupled arguments [ [for p in mi.PApplyArray((fun mi -> mi.GetParameters()), "GetParameters", m) do - let isParamArrayArg = p.PUntaint((fun px -> (px :> IProvidedCustomAttributeProvider).GetAttributeConstructorArgs(p.TypeProvider.PUntaintNoFailure id, typeof.FullName).IsSome), m) + let isParamArrayArg = p.PUntaint((fun px -> (px :> IProvidedCustomAttributeProvider).GetAttributeConstructorArgs(p.TypeProvider.PUntaintNoFailure id, !! typeof.FullName).IsSome), m) let optArgInfo = OptionalArgInfoOfProvidedParameter amap m p let reflArgInfo = - match p.PUntaint((fun px -> (px :> IProvidedCustomAttributeProvider).GetAttributeConstructorArgs(p.TypeProvider.PUntaintNoFailure id, typeof.FullName)), m) with + match p.PUntaint((fun px -> (px :> IProvidedCustomAttributeProvider).GetAttributeConstructorArgs(p.TypeProvider.PUntaintNoFailure id, !! typeof.FullName)), m) with | Some ([ Some (:? bool as b) ], _) -> ReflectedArgInfo.Quote b | Some _ -> ReflectedArgInfo.Quote false | None -> ReflectedArgInfo.None @@ -1726,7 +1726,7 @@ type ILPropInfo = let nullness = {DirectAttributes = AttributesFromIL(pdef.MetadataIndex,pdef.CustomAttrsStored); Fallback = tinfo.NullableClassSource} ImportILTypeFromMetadata amap m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata [] nullness pdef.PropertyType - override x.ToString() = x.ILTypeInfo.ToString() + "::" + x.PropertyName + override x.ToString() = !!x.ILTypeInfo.ToString() + "::" + x.PropertyName /// Describes an F# use of a property [] @@ -2184,7 +2184,7 @@ type ILEventInfo = /// Indicates if the property is static member x.IsStatic = x.AddMethod.IsStatic - override x.ToString() = x.ILTypeInfo.ToString() + "::" + x.EventName + override x.ToString() = !!x.ILTypeInfo.ToString() + "::" + x.EventName //------------------------------------------------------------------------- // Helpers for EventInfo diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index f182639ae1c..08bdb6ca898 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -12078,14 +12078,14 @@ let LookupGeneratedValue (cenv: cenv) (ctxt: ExecutionContext) eenv (v: Val) = if hasLiteralAttr then let staticTy = ctxt.LookupTypeRef fspec.DeclaringTypeRef // Checked: This FieldInfo (FieldBuilder) supports GetValue(). - staticTy.GetField(fspec.Name).GetValue(null: obj) + (!! staticTy.GetField(fspec.Name)).GetValue(null: obj MaybeNull) else let staticTy = ctxt.LookupTypeRef ilContainerTy.TypeRef // We can't call .Invoke on the ILMethodRef's MethodInfo, // because it is the MethodBuilder and that does not support Invoke. // Rather, we look for the getter MethodInfo from the built type and .Invoke on that. let methInfo = - staticTy.GetMethod(ilGetterMethRef.Name, BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic) + !! staticTy.GetMethod(ilGetterMethRef.Name, BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic) methInfo.Invoke(null, null) @@ -12098,7 +12098,7 @@ let LookupGeneratedValue (cenv: cenv) (ctxt: ExecutionContext) eenv (v: Val) = // because it is the MethodBuilder and that does not support Invoke. // Rather, we look for the getter MethodInfo from the built type and .Invoke on that. let methInfo = - staticTy.GetMethod(ilGetterMethSpec.Name, BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic) + !! staticTy.GetMethod(ilGetterMethSpec.Name, BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic) methInfo.Invoke(null, null) @@ -12125,14 +12125,14 @@ let SetGeneratedValue (ctxt: ExecutionContext) eenv isForced (v: Val) (value: ob let staticTy = ctxt.LookupTypeRef fspec.DeclaringTypeRef let fieldInfo = - staticTy.GetField(fspec.Name, BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic) + !! staticTy.GetField(fspec.Name, BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic) fieldInfo.SetValue(null, value) else let staticTy = ctxt.LookupTypeRef ilSetterMethRef.DeclaringTypeRef let methInfo = - staticTy.GetMethod(ilSetterMethRef.Name, BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic) + !! staticTy.GetMethod(ilSetterMethRef.Name, BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic) methInfo.Invoke(null, [| value |]) |> ignore | _ -> () diff --git a/src/Compiler/DependencyManager/AssemblyResolveHandler.fs b/src/Compiler/DependencyManager/AssemblyResolveHandler.fs index c7f56c903f7..a511f39bdb2 100644 --- a/src/Compiler/DependencyManager/AssemblyResolveHandler.fs +++ b/src/Compiler/DependencyManager/AssemblyResolveHandler.fs @@ -6,6 +6,7 @@ open System open System.IO open System.Reflection open Internal.Utilities.FSharpEnvironment +open Internal.Utilities.Library /// Signature for ResolutionProbe callback /// host implements this, it's job is to return a list of assembly paths to probe. @@ -14,25 +15,24 @@ type AssemblyResolutionProbe = delegate of Unit -> seq /// Type that encapsulates AssemblyResolveHandler for managed packages type AssemblyResolveHandlerCoreclr(assemblyProbingPaths: AssemblyResolutionProbe option) as this = let loadContextType = - Type.GetType("System.Runtime.Loader.AssemblyLoadContext, System.Runtime.Loader", false) + !! Type.GetType("System.Runtime.Loader.AssemblyLoadContext, System.Runtime.Loader", false) let loadFromAssemblyPathMethod = - loadContextType.GetMethod("LoadFromAssemblyPath", [| typeof |]) + !! loadContextType.GetMethod("LoadFromAssemblyPath", [| typeof |]) - let eventInfo = loadContextType.GetEvent("Resolving") + let eventInfo = !! loadContextType.GetEvent("Resolving") let handler, defaultAssemblyLoadContext = let ti = typeof let gmi = - ti.GetMethod("ResolveAssemblyNetStandard", BindingFlags.Instance ||| BindingFlags.NonPublic) + !! ti.GetMethod("ResolveAssemblyNetStandard", BindingFlags.Instance ||| BindingFlags.NonPublic) let mi = gmi.MakeGenericMethod(loadContextType) - let del = Delegate.CreateDelegate(eventInfo.EventHandlerType, this, mi) + let del = Delegate.CreateDelegate(!!eventInfo.EventHandlerType, this, mi) let prop = - loadContextType - .GetProperty("Default", BindingFlags.Static ||| BindingFlags.Public) + (!! loadContextType.GetProperty("Default", BindingFlags.Static ||| BindingFlags.Public)) .GetValue(null, null) del, prop @@ -113,7 +113,7 @@ type AssemblyResolveHandler internal (assemblyProbingPaths: AssemblyResolutionPr else new AssemblyResolveHandlerDeskTop(assemblyProbingPaths) :> IDisposable) - new(assemblyProbingPaths: AssemblyResolutionProbe) = new AssemblyResolveHandler(Option.ofObj assemblyProbingPaths) + new(assemblyProbingPaths: AssemblyResolutionProbe MaybeNull) = new AssemblyResolveHandler(Option.ofObj assemblyProbingPaths) interface IDisposable with member _.Dispose() = diff --git a/src/Compiler/DependencyManager/DependencyProvider.fs b/src/Compiler/DependencyManager/DependencyProvider.fs index 0fb7be23b6c..631a6e73b02 100644 --- a/src/Compiler/DependencyManager/DependencyProvider.fs +++ b/src/Compiler/DependencyManager/DependencyProvider.fs @@ -15,8 +15,11 @@ open System.Collections.Concurrent module Option = /// Convert string into Option string where null and String.Empty result in None - let ofString s = - if String.IsNullOrEmpty(s) then None else Some(s) + let ofString (s: string MaybeNull) = + match s with + | null -> None + | "" -> None + | s -> Some s [] module ReflectionHelper = @@ -57,31 +60,27 @@ module ReflectionHelper = let instanceFlags = BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance - let property = - theType.GetProperty(propertyName, instanceFlags, null, typeof<'T>, [||], [||]) - - if isNull property then - None - else - let getMethod = property.GetGetMethod() - - if not (isNull getMethod) && not getMethod.IsStatic then - Some property - else - None + match theType.GetProperty(propertyName, instanceFlags, null, typeof<'T>, [||], [||]) with + | null -> None + | property -> + match property.GetGetMethod() with + | null -> None + | getMethod when getMethod.IsStatic -> None + | _ -> Some property with _ -> None let getInstanceMethod<'T> (theType: Type) (parameterTypes: Type[]) methodName = try - let theMethod = theType.GetMethod(methodName, parameterTypes) - if isNull theMethod then None else Some theMethod + match theType.GetMethod(methodName, parameterTypes) with + | null -> None + | theMethod -> Some theMethod with _ -> None let stripTieWrapper (e: Exception) = match e with - | :? TargetInvocationException as e -> e.InnerException + | :? TargetInvocationException as e when isNotNull e.InnerException -> !!e.InnerException | _ -> e /// Indicate the type of error to report @@ -500,7 +499,7 @@ type DependencyProvider let assemblyLocation = typeof.GetTypeInfo().Assembly.Location - yield Path.GetDirectoryName assemblyLocation + yield !!(Path.GetDirectoryName assemblyLocation) yield AppDomain.CurrentDomain.BaseDirectory ]) diff --git a/src/Compiler/DependencyManager/NativeDllResolveHandler.fs b/src/Compiler/DependencyManager/NativeDllResolveHandler.fs index 8a3161a89d8..6319f3df48b 100644 --- a/src/Compiler/DependencyManager/NativeDllResolveHandler.fs +++ b/src/Compiler/DependencyManager/NativeDllResolveHandler.fs @@ -24,12 +24,12 @@ type internal ProbingPathsStore() = else p - static member RemoveProbeFromProcessPath probePath = + static member RemoveProbeFromProcessPath(probePath: string) = if not (String.IsNullOrWhiteSpace(probePath)) then let probe = ProbingPathsStore.AppendPathSeparator probePath let path = - ProbingPathsStore.AppendPathSeparator(Environment.GetEnvironmentVariable("PATH")) + ProbingPathsStore.AppendPathSeparator(Environment.GetEnvironmentVariable("PATH") |> defaultIfNull "") if path.Contains(probe) then Environment.SetEnvironmentVariable("PATH", path.Replace(probe, "")) @@ -38,7 +38,7 @@ type internal ProbingPathsStore() = let probe = ProbingPathsStore.AppendPathSeparator probePath let path = - ProbingPathsStore.AppendPathSeparator(Environment.GetEnvironmentVariable("PATH")) + ProbingPathsStore.AppendPathSeparator(Environment.GetEnvironmentVariable("PATH") |> defaultIfNull "") if not (path.Contains(probe)) then Environment.SetEnvironmentVariable("PATH", path + probe) @@ -72,9 +72,9 @@ type internal NativeDllResolveHandlerCoreClr(nativeProbingRoots: NativeResolutio let nativeLibraryTryLoad = let nativeLibraryType: Type = - Type.GetType("System.Runtime.InteropServices.NativeLibrary, System.Runtime.InteropServices", false) + !! Type.GetType("System.Runtime.InteropServices.NativeLibrary, System.Runtime.InteropServices", false) - nativeLibraryType.GetMethod("TryLoad", [| typeof; typeof.MakeByRefType() |]) + !! nativeLibraryType.GetMethod("TryLoad", [| typeof; typeof.MakeByRefType() |]) let loadNativeLibrary path = let arguments = [| path :> obj; IntPtr.Zero :> obj |] @@ -157,13 +157,12 @@ type internal NativeDllResolveHandlerCoreClr(nativeProbingRoots: NativeResolutio // netstandard 2.1 has this property, unfortunately we don't build with that yet //public event Func ResolvingUnmanagedDll let assemblyLoadContextType: Type = - Type.GetType("System.Runtime.Loader.AssemblyLoadContext, System.Runtime.Loader", false) + !! Type.GetType("System.Runtime.Loader.AssemblyLoadContext, System.Runtime.Loader", false) let eventInfo, handler, defaultAssemblyLoadContext = - assemblyLoadContextType.GetEvent("ResolvingUnmanagedDll"), + !! assemblyLoadContextType.GetEvent("ResolvingUnmanagedDll"), Func resolveUnmanagedDll, - assemblyLoadContextType - .GetProperty("Default", BindingFlags.Static ||| BindingFlags.Public) + (!! assemblyLoadContextType.GetProperty("Default", BindingFlags.Static ||| BindingFlags.Public)) .GetValue(null, null) do eventInfo.AddEventHandler(defaultAssemblyLoadContext, handler) @@ -185,7 +184,7 @@ type NativeDllResolveHandler(nativeProbingRoots: NativeResolutionProbe option) = |> Option.filter (fun _ -> isRunningOnCoreClr) |> Option.map (fun _ -> new NativeDllResolveHandlerCoreClr(nativeProbingRoots)) - new(nativeProbingRoots: NativeResolutionProbe) = new NativeDllResolveHandler(Option.ofObj nativeProbingRoots) + new(nativeProbingRoots: NativeResolutionProbe MaybeNull) = new NativeDllResolveHandler(Option.ofObj nativeProbingRoots) member internal _.RefreshPathsInEnvironment(roots: string seq) = handler |> Option.iter (fun handler -> handler.RefreshPathsInEnvironment(roots)) diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index 4a1d0d18c74..0d3b11059fb 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -180,7 +180,7 @@ type VersionFlag = else use fs = FileSystem.OpenFileForReadShim(s) use is = new StreamReader(fs) - is.ReadLine() + !! is.ReadLine() | VersionNone -> "0.0.0.0" /// Represents a reference to an assembly. May be backed by a real assembly on disk, or a cross-project @@ -635,7 +635,11 @@ type TcConfigBuilder = seq { yield! tcConfigB.includes yield! tcConfigB.compilerToolPaths - yield! (tcConfigB.referencedDLLs |> Seq.map (fun ref -> Path.GetDirectoryName(ref.Text))) + + yield! + (tcConfigB.referencedDLLs + |> Seq.map (fun ref -> !! Path.GetDirectoryName(ref.Text))) + tcConfigB.implicitIncludeDir } |> Seq.distinct @@ -654,8 +658,8 @@ type TcConfigBuilder = rangeForErrors ) = - if (String.IsNullOrEmpty defaultFSharpBinariesDir) then - failwith "Expected a valid defaultFSharpBinariesDir" + let defaultFSharpBinariesDir = + nullArgCheck "defaultFSharpBinariesDir" defaultFSharpBinariesDir // These are all default values, many can be overridden using the command line switch { @@ -1107,7 +1111,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = // clone the input builder to ensure nobody messes with it. let data = { data with pause = data.pause } - let computeKnownDllReference libraryName = + let computeKnownDllReference (libraryName: string) = let defaultCoreLibraryReference = AssemblyReference(range0, libraryName + ".dll", None) @@ -1159,7 +1163,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = ComputeMakePathAbsolute data.implicitIncludeDir primaryAssemblyFilename try - let clrRoot = Some(Path.GetDirectoryName(FileSystem.GetFullPathShim fileName)) + let clrRoot = Some(!! Path.GetDirectoryName(FileSystem.GetFullPathShim fileName)) clrRoot, data.legacyReferenceResolver.Impl.HighestInstalledNetFrameworkVersion() with e -> // We no longer expect the above to fail but leaving this just in case @@ -1459,7 +1463,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = /// 'framework' reference set that is potentially shared across multiple compilations. member tcConfig.IsSystemAssembly(fileName: string) = try - let dirName = Path.GetDirectoryName fileName + let dirName = !! Path.GetDirectoryName(fileName) let baseName = FileSystemUtils.fileNameWithoutExtension fileName FileSystem.FileExistsShim fileName diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 00c1fdec81a..1caf0aa6ed9 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -210,7 +210,7 @@ type Exception with | HashLoadedSourceHasIssues(_, _, _, m) | HashLoadedScriptConsideredSource m -> Some m // Strip TargetInvocationException wrappers - | :? System.Reflection.TargetInvocationException as e -> e.InnerException.DiagnosticRange + | :? System.Reflection.TargetInvocationException as e when isNotNull e.InnerException -> (!!e.InnerException).DiagnosticRange #if !NO_TYPEPROVIDERS | :? TypeProviderError as e -> e.Range |> Some #endif @@ -338,7 +338,7 @@ type Exception with | ArgumentsInSigAndImplMismatch _ -> 3218 // Strip TargetInvocationException wrappers - | :? TargetInvocationException as e -> e.InnerException.DiagnosticNumber + | :? TargetInvocationException as e when isNotNull e.InnerException -> (!!e.InnerException).DiagnosticNumber | WrappedError(e, _) -> e.DiagnosticNumber | DiagnosticWithText(n, _, _) -> n | DiagnosticWithSuggestions(n, _, _, _, _) -> n @@ -1945,7 +1945,7 @@ type Exception with ) // Strip TargetInvocationException wrappers - | :? TargetInvocationException as exn -> exn.InnerException.Output(os, suggestNames) + | :? TargetInvocationException as e when isNotNull e.InnerException -> (!!e.InnerException).Output(os, suggestNames) | :? FileNotFoundException as exn -> Printf.bprintf os "%s" exn.Message diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index 334a834db32..1c7f474fd7a 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -163,7 +163,7 @@ let PickleToResource inMem file (g: TcGlobals) compress scope rName rNameB p x = let byteStorage = ByteStorage.FromByteArray(bytes) let byteStorageB = - if inMem then + if inMem then ByteStorage.FromMemoryAndCopy(bytesB.AsMemory(), useBackingMemoryMappedFile = true) else ByteStorage.FromByteArray(bytesB.AsMemory().ToArray()) @@ -478,15 +478,15 @@ let isHashRReference (r: range) = && not (equals r rangeCmdArgs) && FileSystem.IsPathRootedShim r.FileName -let IsNetModule fileName = +let IsNetModule (fileName:string) = let ext = Path.GetExtension fileName String.Compare(ext, ".netmodule", StringComparison.OrdinalIgnoreCase) = 0 -let IsDLL fileName = +let IsDLL (fileName:string) = let ext = Path.GetExtension fileName String.Compare(ext, ".dll", StringComparison.OrdinalIgnoreCase) = 0 -let IsExe fileName = +let IsExe (fileName:string) = let ext = Path.GetExtension fileName String.Compare(ext, ".exe", StringComparison.OrdinalIgnoreCase) = 0 @@ -541,7 +541,7 @@ type TcConfig with yield! tcConfig.GetSearchPathsForLibraryFiles() if isHashRReference m then - Path.GetDirectoryName(m.FileName) + !! Path.GetDirectoryName(m.FileName) } let resolved = TryResolveFileUsingPaths(searchPaths, m, nm) @@ -989,7 +989,7 @@ type RawFSharpAssemblyDataBackedByFileOnDisk(ilModule: ILModuleDef, ilAssemblyRe let sigDataReaders = if sigDataReaders.IsEmpty && List.contains ilShortAssemName externalSigAndOptData then - let sigFileName = Path.ChangeExtension(fileName, "sigdata") + let sigFileName = !! Path.ChangeExtension(fileName, "sigdata") if not (FileSystem.FileExistsShim sigFileName) then error (Error(FSComp.SR.buildExpectedSigdataFile (FileSystem.GetFullPathShim sigFileName), m)) @@ -1014,7 +1014,7 @@ type RawFSharpAssemblyDataBackedByFileOnDisk(ilModule: ILModuleDef, ilAssemblyRe // Look for optimization data in a file let optDataReaders = if optDataReaders.IsEmpty && List.contains ilShortAssemName externalSigAndOptData then - let optDataFile = Path.ChangeExtension(fileName, "optdata") + let optDataFile = !! Path.ChangeExtension(fileName, "optdata") if not (FileSystem.FileExistsShim optDataFile) then error ( @@ -1464,7 +1464,7 @@ and [] TcImports | Tainted.Null -> false, None | Tainted.NonNull assembly -> let aname = assembly.PUntaint((fun a -> a.GetName()), m) - let ilShortAssemName = aname.Name + let ilShortAssemName = string aname.Name match tcImports.FindCcu(ctok, m, ilShortAssemName, lookupOnly = true) with | ResolvedCcu ccu -> @@ -1477,7 +1477,7 @@ and [] TcImports | UnresolvedCcu _ -> let g = tcImports.GetTcGlobals() let ilScopeRef = ILScopeRef.Assembly(ILAssemblyRef.FromAssemblyName aname) - let fileName = aname.Name + ".dll" + let fileName = string aname.Name + ".dll" let bytes = assembly @@ -1860,7 +1860,7 @@ and [] TcImports |> Option.get // MSDN: this method causes the file to be opened and closed, but the assembly is not added to this domain let name = AssemblyName.GetAssemblyName(resolution.resolvedPath) - name.Version + !! name.Version // Note, this only captures systemRuntimeContainsTypeRef (which captures tcImportsWeak, using name tcImports) let systemRuntimeContainsType = @@ -1961,7 +1961,7 @@ and [] TcImports match providers with | [] -> - let typeName = typeof.FullName + let typeName = !! typeof.FullName warning (Error(FSComp.SR.etHostingAssemblyFoundWithoutHosts (fileNameOfRuntimeAssembly, typeName), m)) | _ -> diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index a43d686fb01..5221f4587c2 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -248,7 +248,7 @@ module ResponseFile = let data = seq { while not reader.EndOfStream do - reader.ReadLine() + !! reader.ReadLine() } |> Seq.choose parseLine |> List.ofSeq @@ -680,8 +680,8 @@ let SetEmbedAllSourceSwitch (tcConfigB: TcConfigBuilder) switch = else tcConfigB.embedAllSource <- false -let setOutFileName tcConfigB path = - let outputDir = Path.GetDirectoryName(path) +let setOutFileName tcConfigB (path: string) = + let outputDir = !! Path.GetDirectoryName(path) tcConfigB.outputDir <- Some outputDir tcConfigB.outputFile <- Some path diff --git a/src/Compiler/Driver/CreateILModule.fs b/src/Compiler/Driver/CreateILModule.fs index 506171ed0ef..5ed836631d7 100644 --- a/src/Compiler/Driver/CreateILModule.fs +++ b/src/Compiler/Driver/CreateILModule.fs @@ -523,7 +523,7 @@ module MainModuleBuilder = $"%d{fileVersionInfo.Major}.%d{fileVersionInfo.Minor}.%d{fileVersionInfo.Build}.%d{fileVersionInfo.Revision}") ("ProductVersion", productVersionString) match tcConfig.outputFile with - | Some f -> ("OriginalFilename", Path.GetFileName f) + | Some f -> ("OriginalFilename", !! Path.GetFileName(f)) | None -> () yield! FindAttribute "Comments" "System.Reflection.AssemblyDescriptionAttribute" yield! FindAttribute "FileDescription" "System.Reflection.AssemblyTitleAttribute" diff --git a/src/Compiler/Driver/FxResolver.fs b/src/Compiler/Driver/FxResolver.fs index 39708bae4ef..dfeff2cabf3 100644 --- a/src/Compiler/Driver/FxResolver.fs +++ b/src/Compiler/Driver/FxResolver.fs @@ -69,7 +69,7 @@ type internal FxResolver | NonNull message -> lock errorslock (fun () -> errorsList.Add(message)) let psi = ProcessStartInfo() - psi.FileName <- pathToExe + psi.FileName <- !!pathToExe if workingDir.IsSome then psi.WorkingDirectory <- workingDir.Value @@ -91,7 +91,7 @@ type internal FxResolver p.BeginOutputReadLine() p.BeginErrorReadLine() - if not (p.WaitForExit(timeout)) then + if not (p.WaitForExit(timeout: int)) then // Timed out resolving throw a diagnostic. raise (TimeoutException(sprintf "Timeout executing command '%s' '%s'" psi.FileName psi.Arguments)) else @@ -213,7 +213,7 @@ type internal FxResolver if String.IsNullOrWhiteSpace fileName then getFSharpCompilerLocation () else - fileName + !!fileName // Compute the framework implementation directory, either of the selected SDK or the currently running process as a backup // F# interactive/reflective scenarios use the implementation directory of the currently running process @@ -284,7 +284,10 @@ type internal FxResolver try let asm = typeof>.Assembly - if asm.FullName.StartsWith("System.ValueTuple", StringComparison.OrdinalIgnoreCase) then + if + (!!asm.FullName) + .StartsWith("System.ValueTuple", StringComparison.OrdinalIgnoreCase) + then Some asm.Location else let valueTuplePath = @@ -318,7 +321,7 @@ type internal FxResolver version, "" match Version.TryParse(ver) with - | true, v -> v, suffix + | true, v -> !!v, suffix | false, _ -> zeroVersion, suffix let compareVersion (v1: Version * string) (v2: Version * string) = @@ -371,7 +374,7 @@ type internal FxResolver let di = tryGetVersionedSubDirectory "packs/Microsoft.NETCore.App.Ref" version match di with - | Some di -> (Some(di.Name), Some(di.Parent.FullName)), warnings + | Some di -> (Some(di.Name), Some((!!di.Parent).FullName)), warnings | None -> (None, None), warnings with e -> let warn = @@ -495,7 +498,7 @@ type internal FxResolver try if FileSystem.FileExistsShim(reference) then // Reference is a path to a file on disk - Path.GetFileNameWithoutExtension(reference), reference + !! Path.GetFileNameWithoutExtension(reference), reference else // Reference is a SimpleAssembly name reference, frameworkPathFromSimpleName reference @@ -936,7 +939,7 @@ type internal FxResolver if useFsiAuxLib then getFsiLibraryImplementationReference () ] - |> List.filter (Path.GetFileNameWithoutExtension >> systemAssemblies.Contains) + |> List.filter (Path.GetFileNameWithoutExtension >> (!!) >> systemAssemblies.Contains) sdkReferences, false with e -> diff --git a/src/Compiler/Driver/GraphChecking/Graph.fs b/src/Compiler/Driver/GraphChecking/Graph.fs index dbe4c6b6cc7..eae29cdb55c 100644 --- a/src/Compiler/Driver/GraphChecking/Graph.fs +++ b/src/Compiler/Driver/GraphChecking/Graph.fs @@ -84,7 +84,7 @@ module internal Graph = |> Seq.iter (fun (KeyValue(file, deps)) -> printfn $"{file} -> {deps |> Array.map nodePrinter |> join}") let print (graph: Graph<'Node>) : unit = - printCustom graph (fun node -> node.ToString()) + printCustom graph (fun node -> node.ToString() |> string) let serialiseToMermaid (graph: Graph) = let sb = StringBuilder() diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 7f7dd55ef7a..8dacc668892 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -352,8 +352,8 @@ let PostParseModuleSpecs type ModuleNamesDict = Map> /// Checks if a module name is already given and deduplicates the name if needed. -let DeduplicateModuleName (moduleNamesDict: ModuleNamesDict) fileName (qualNameOfFile: QualifiedNameOfFile) = - let path = Path.GetDirectoryName fileName +let DeduplicateModuleName (moduleNamesDict: ModuleNamesDict) (fileName: string) (qualNameOfFile: QualifiedNameOfFile) = + let path = !! Path.GetDirectoryName(fileName) let path = if FileSystem.IsPathRootedShim path then @@ -434,7 +434,7 @@ let ParseInput "ParseAndCheckFile.parseFile" [| Activity.Tags.fileName, fileName - Activity.Tags.buildPhase, BuildPhase.Parse.ToString() + Activity.Tags.buildPhase, !! BuildPhase.Parse.ToString() Activity.Tags.userOpName, userOpName |> Option.defaultValue "" |] @@ -884,7 +884,7 @@ let ProcessMetaCommandsFromInput match args with | [ path ] -> - let p = if String.IsNullOrWhiteSpace(path) then "" else path + let p = if String.IsNullOrWhiteSpace(path) then "" else !!path hashReferenceF state (m, p, directive) diff --git a/src/Compiler/Driver/ScriptClosure.fs b/src/Compiler/Driver/ScriptClosure.fs index 2374fd6793b..de5f3788d03 100644 --- a/src/Compiler/Driver/ScriptClosure.fs +++ b/src/Compiler/Driver/ScriptClosure.fs @@ -159,7 +159,7 @@ module ScriptPreprocessClosure = reduceMemoryUsage ) = - let projectDir = Path.GetDirectoryName fileName + let projectDir = !! Path.GetDirectoryName(fileName) let isInteractive = (codeContext = CodeContext.CompilationAndEvaluation) let isInvalidationSupported = (codeContext = CodeContext.Editing) @@ -460,7 +460,7 @@ module ScriptPreprocessClosure = let diagnosticsLogger = CapturingDiagnosticsLogger("FindClosureMetaCommands") use _ = UseDiagnosticsLogger diagnosticsLogger - let pathOfMetaCommandSource = Path.GetDirectoryName fileName + let pathOfMetaCommandSource = !! Path.GetDirectoryName(fileName) let preSources = tcConfig.GetAvailableLoadedSources() let tcConfigResult, noWarns = diff --git a/src/Compiler/Driver/StaticLinking.fs b/src/Compiler/Driver/StaticLinking.fs index 9481b4e1006..53916744622 100644 --- a/src/Compiler/Driver/StaticLinking.fs +++ b/src/Compiler/Driver/StaticLinking.fs @@ -158,7 +158,7 @@ let StaticLinkILModules match depILModule.Manifest with | Some m -> for ca in m.CustomAttrs.AsArray() do - if ca.Method.MethodRef.DeclaringTypeRef.FullName = typeof.FullName then + if ca.Method.MethodRef.DeclaringTypeRef.FullName = !!typeof.FullName then ca | _ -> () ] diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 34322176136..ac4ee179538 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -371,7 +371,7 @@ module InterfaceFileWriter = let writeToSeparateFiles (declaredImpls: CheckedImplFile list) = for CheckedImplFile(qualifiedNameOfFile = name) as impl in declaredImpls do let fileName = - Path.ChangeExtension(name.Range.FileName, extensionForFile name.Range.FileName) + !! Path.ChangeExtension(name.Range.FileName, extensionForFile name.Range.FileName) printfn "writing impl file to %s" fileName use os = FileSystem.OpenFileForWriteShim(fileName, FileMode.Create).GetWriter() @@ -392,7 +392,7 @@ module InterfaceFileWriter = // 2) If not, but FSharp.Core.dll exists beside the compiler binaries, it will copy it to output directory. // 3) If not, it will produce an error. let CopyFSharpCore (outFile: string, referencedDlls: AssemblyReference list) = - let outDir = Path.GetDirectoryName outFile + let outDir = !! Path.GetDirectoryName(outFile) let fsharpCoreAssemblyName = GetFSharpCoreLibraryName() + ".dll" let fsharpCoreDestinationPath = Path.Combine(outDir, fsharpCoreAssemblyName) @@ -412,7 +412,7 @@ let CopyFSharpCore (outFile: string, referencedDlls: AssemblyReference list) = | Some referencedFsharpCoreDll -> copyFileIfDifferent referencedFsharpCoreDll.Text fsharpCoreDestinationPath | None -> let executionLocation = Assembly.GetExecutingAssembly().Location - let compilerLocation = Path.GetDirectoryName executionLocation + let compilerLocation = !! Path.GetDirectoryName(executionLocation) let compilerFsharpCoreDllPath = Path.Combine(compilerLocation, fsharpCoreAssemblyName) diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index 3a46aab75a9..45bee0522cc 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -13,6 +13,15 @@ FSharp.Compiler.Service true $(DefineConstants);COMPILER + true + + $(FSharpNetCoreProductDefaultTargetFramework);$(TargetFrameworks) $(DefineConstants);FSHARPCORE_USE_PACKAGE $(OtherFlags) --extraoptimizationloops:1 @@ -87,6 +96,7 @@ + FSComp.txt @@ -96,10 +106,11 @@ FSStrings.resx FSStrings.resources - - + + + @@ -112,8 +123,6 @@ - - diff --git a/src/Compiler/Facilities/AsyncMemoize.fs b/src/Compiler/Facilities/AsyncMemoize.fs index 49c08e5320a..d22093a2b4f 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fs +++ b/src/Compiler/Facilities/AsyncMemoize.fs @@ -11,14 +11,15 @@ open FSharp.Compiler open FSharp.Compiler.BuildGraph open FSharp.Compiler.Diagnostics open FSharp.Compiler.DiagnosticsLogger +open Internal.Utilities.Library open System.Runtime.CompilerServices [] module internal Utils = /// Return file name with one directory above it - let shortPath path = - let dirPath = Path.GetDirectoryName path + let shortPath (path: string) = + let dirPath = !! Path.GetDirectoryName(path) let dir = dirPath.Split Path.DirectorySeparatorChar @@ -146,7 +147,12 @@ type internal CachingDiagnosticsLogger(originalLogger: DiagnosticsLogger option) member _.CapturedDiagnostics = capturedDiagnostics |> Seq.toList [] -type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'TVersion: equality> +type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'TVersion: equality +#if !NO_CHECKNULLS + and 'TKey:not null + and 'TVersion:not null +#endif + > (?keepStrongly, ?keepWeakly, ?name: string, ?cancelDuplicateRunningJobs: bool) = let name = defaultArg name "N/A" @@ -287,7 +293,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T key.Version, key.Label, (Running( - TaskCompletionSource(TaskCreationOptions.RunContinuationsAsynchronously), + TaskCompletionSource<'TValue>(TaskCreationOptions.RunContinuationsAsynchronously), cts, computation, DateTime.Now, @@ -474,7 +480,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T { new ICacheKey<_, _> with member _.GetKey() = key member _.GetVersion() = Unchecked.defaultof<_> - member _.GetLabel() = key.ToString() + member _.GetLabel() = match key.ToString() with | null -> "" | s -> s } this.Get(wrappedKey, computation) diff --git a/src/Compiler/Facilities/AsyncMemoize.fsi b/src/Compiler/Facilities/AsyncMemoize.fsi index 88288ea4fc8..c3273f472cd 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fsi +++ b/src/Compiler/Facilities/AsyncMemoize.fsi @@ -52,7 +52,12 @@ type internal AsyncLock = /// /// Strongly holds at most one result per key. /// -type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'TVersion: equality> = +type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'TVersion: equality +#if !NO_CHECKNULLS + and 'TKey:not null + and 'TVersion:not null +#endif + > = /// Maximum number of strongly held results to keep in the cache /// Maximum number of weakly held results to keep in the cache diff --git a/src/Compiler/Facilities/CompilerLocation.fs b/src/Compiler/Facilities/CompilerLocation.fs index 31b87846be5..9cd20c1863e 100644 --- a/src/Compiler/Facilities/CompilerLocation.fs +++ b/src/Compiler/Facilities/CompilerLocation.fs @@ -8,6 +8,7 @@ open System.IO open System.Reflection open System.Runtime.InteropServices open Microsoft.FSharp.Core +open Internal.Utilities.Library #nowarn "44" // ConfigurationSettings is obsolete but the new stuff is horribly complicated. @@ -23,7 +24,10 @@ module internal FSharpEnvironment = let FSharpProductName = UtilsStrings.SR.buildProductName (FSharpBannerVersion) - let versionOf<'t> = typeof<'t>.Assembly.GetName().Version.ToString() + let versionOf<'t> : MaybeNull = + match typeof<'t>.Assembly.GetName().Version with + | null -> null + | v -> v.ToString() let FSharpCoreLibRunningVersion = try @@ -40,8 +44,9 @@ module internal FSharpEnvironment = let FSharpBinaryMetadataFormatRevision = "2.0.0.0" let isRunningOnCoreClr = - typeof.Assembly.FullName - .StartsWith("System.Private.CoreLib", StringComparison.InvariantCultureIgnoreCase) + match typeof.Assembly.FullName with + | null -> false + | name -> name.StartsWith("System.Private.CoreLib", StringComparison.InvariantCultureIgnoreCase) module Option = /// Convert string into Option string where null and String.Empty result in None @@ -69,7 +74,7 @@ module internal FSharpEnvironment = try // We let you set FSHARP_COMPILER_BIN. I've rarely seen this used and its not documented in the install instructions. match Environment.GetEnvironmentVariable("FSHARP_COMPILER_BIN") with - | result when not (String.IsNullOrWhiteSpace result) -> Some result + | result when not (String.IsNullOrWhiteSpace result) -> Some !!result | _ -> let safeExists f = (try @@ -83,7 +88,8 @@ module internal FSharpEnvironment = | _ -> let fallback () = let d = Assembly.GetExecutingAssembly() - Some(Path.GetDirectoryName d.Location) + + Some(!! Path.GetDirectoryName(d.Location)) match tryCurrentDomain () with | None -> fallback () @@ -185,7 +191,7 @@ module internal FSharpEnvironment = | Some(p: string) -> match Path.GetDirectoryName(p) with | s when String.IsNullOrEmpty(s) || Path.GetFileName(p) = "packages" || s = p -> () - | parentDir -> yield! searchParentDirChain (Some parentDir) assemblyName + | parentDir -> yield! searchParentDirChain (Option.ofObj parentDir) assemblyName for p in searchToolPaths path compilerToolPaths do let fileName = Path.Combine(p, assemblyName) @@ -196,7 +202,9 @@ module internal FSharpEnvironment = let loadFromParentDirRelativeToRuntimeAssemblyLocation designTimeAssemblyName = let runTimeAssemblyPath = Path.GetDirectoryName runTimeAssemblyFileName - let paths = searchParentDirChain (Some runTimeAssemblyPath) designTimeAssemblyName + + let paths = + searchParentDirChain (Option.ofObj runTimeAssemblyPath) designTimeAssemblyName paths |> Seq.tryHead @@ -204,7 +212,7 @@ module internal FSharpEnvironment = | Some res -> loadFromLocation res | None -> // The search failed, just load from the first location and report an error - let runTimeAssemblyPath = Path.GetDirectoryName runTimeAssemblyFileName + let runTimeAssemblyPath = !! Path.GetDirectoryName(runTimeAssemblyFileName) loadFromLocation (Path.Combine(runTimeAssemblyPath, designTimeAssemblyName)) if designTimeAssemblyName.EndsWith(".dll", StringComparison.OrdinalIgnoreCase) then @@ -215,9 +223,9 @@ module internal FSharpEnvironment = // design-time DLLs specified using "x.DesignTIme, Version= ..." long assembly names and GAC loads. // These kind of design-time assembly specifications are no longer used to our knowledge so that comparison is basically legacy // and will always succeed. - let name = AssemblyName(Path.GetFileNameWithoutExtension designTimeAssemblyName) + let name = AssemblyName(!! Path.GetFileNameWithoutExtension(designTimeAssemblyName)) - if name.Name.Equals(name.FullName, StringComparison.OrdinalIgnoreCase) then + if name.FullName.Equals(name.Name, StringComparison.OrdinalIgnoreCase) then let designTimeFileName = designTimeAssemblyName + ".dll" loadFromParentDirRelativeToRuntimeAssemblyLocation designTimeFileName else @@ -237,7 +245,8 @@ module internal FSharpEnvironment = let getFSharpCompilerLocationWithDefaultFromType (defaultLocation: Type) = let location = try - Some(Path.GetDirectoryName(defaultLocation.Assembly.Location)) + let directory = Path.GetDirectoryName(defaultLocation.Assembly.Location) + Option.ofObj (directory) with _ -> None @@ -266,7 +275,7 @@ module internal FSharpEnvironment = // Must be alongside the location of FSharp.CompilerService.dll let getDefaultFsiLibraryLocation () = - Path.Combine(Path.GetDirectoryName(getFSharpCompilerLocation ()), fsiLibraryName + ".dll") + Path.Combine(!! Path.GetDirectoryName(getFSharpCompilerLocation ()), fsiLibraryName + ".dll") let isWindows = RuntimeInformation.IsOSPlatform(OSPlatform.Windows) @@ -286,7 +295,7 @@ module internal FSharpEnvironment = if String.IsNullOrEmpty(pf) then Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) else - pf + !!pf let candidate = Path.Combine(pf, "dotnet", dotnet) @@ -311,20 +320,23 @@ module internal FSharpEnvironment = let probePathForDotnetHost () = let paths = let p = Environment.GetEnvironmentVariable("PATH") - if not (isNull p) then p.Split(Path.PathSeparator) else [||] + + match p with + | null -> [||] + | p -> p.Split(Path.PathSeparator) paths |> Array.tryFind (fun f -> fileExists (Path.Combine(f, dotnet))) match (Environment.GetEnvironmentVariable("DOTNET_HOST_PATH")) with // Value set externally - | value when not (String.IsNullOrEmpty(value)) && fileExists value -> Some value + | NonEmptyString value when fileExists value -> Some value | _ -> // Probe for netsdk install, dotnet. and dotnet.exe is a constant offset from the location of System.Int32 let candidate = let assemblyLocation = Path.GetDirectoryName(typeof.GetTypeInfo().Assembly.Location) - Path.GetFullPath(Path.Combine(assemblyLocation, "..", "..", "..", dotnet)) + Path.GetFullPath(Path.Combine(!!assemblyLocation, "..", "..", "..", dotnet)) if fileExists candidate then Some candidate @@ -342,12 +354,12 @@ module internal FSharpEnvironment = [| match getDotnetHostPath (), getDotnetGlobalHostPath () with | Some hostPath, Some globalHostPath -> - yield Path.GetDirectoryName(hostPath) + yield !! Path.GetDirectoryName(hostPath) if isDotnetMultilevelLookup && hostPath <> globalHostPath then - yield Path.GetDirectoryName(globalHostPath) - | Some hostPath, None -> yield Path.GetDirectoryName(hostPath) - | None, Some globalHostPath -> yield Path.GetDirectoryName(globalHostPath) + yield !! Path.GetDirectoryName(globalHostPath) + | Some hostPath, None -> yield !! Path.GetDirectoryName(hostPath) + | None, Some globalHostPath -> yield !! Path.GetDirectoryName(globalHostPath) | None, None -> () |] diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 8925022b5e1..af19ae2f617 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -176,7 +176,7 @@ let rec AttachRange m (exn: exn) = else match exn with // Strip TargetInvocationException wrappers - | :? TargetInvocationException -> AttachRange m exn.InnerException + | :? TargetInvocationException as e when isNotNull e.InnerException -> AttachRange m !!exn.InnerException | UnresolvedReferenceNoRange a -> UnresolvedReferenceError(a, m) | UnresolvedPathReferenceNoRange(a, p) -> UnresolvedPathReference(a, p, m) | :? NotSupportedException -> exn @@ -426,7 +426,7 @@ module DiagnosticsLoggerExtensions = try if not tryAndDetectDev15 then let preserveStackTrace = - typeof + !!typeof .GetMethod("InternalPreserveStackTrace", BindingFlags.Instance ||| BindingFlags.NonPublic) preserveStackTrace.Invoke(exn, null) |> ignore diff --git a/src/Compiler/Facilities/SimulatedMSBuildReferenceResolver.fs b/src/Compiler/Facilities/SimulatedMSBuildReferenceResolver.fs index 017cdfaacea..be848a631c9 100644 --- a/src/Compiler/Facilities/SimulatedMSBuildReferenceResolver.fs +++ b/src/Compiler/Facilities/SimulatedMSBuildReferenceResolver.fs @@ -54,7 +54,7 @@ let private SimulatedMSBuildResolver = let isDesktop = typeof.Assembly.GetName().Name = "mscorlib" if isDesktop then - match System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory() with + match (System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory(): string MaybeNull) with | null -> [] | x -> [ x ] else @@ -82,7 +82,7 @@ let private SimulatedMSBuildResolver = if Environment.OSVersion.Platform = PlatformID.Win32NT then let PF = match Environment.GetEnvironmentVariable("ProgramFiles(x86)") with - | null -> Environment.GetEnvironmentVariable("ProgramFiles") // if PFx86 is null, then we are 32-bit and just get PF + | null -> !! Environment.GetEnvironmentVariable("ProgramFiles") // if PFx86 is null, then we are 32-bit and just get PF | s -> s PF + @"\Reference Assemblies\Microsoft\Framework\.NETFramework" @@ -150,14 +150,14 @@ let private SimulatedMSBuildResolver = let fscoreDir0 = let PF = match Environment.GetEnvironmentVariable("ProgramFiles(x86)") with - | null -> Environment.GetEnvironmentVariable("ProgramFiles") + | null -> !! Environment.GetEnvironmentVariable("ProgramFiles") | s -> s PF + @"\Reference Assemblies\Microsoft\FSharp\.NETFramework\v4.0\" - + n.Version.ToString() + + (!!n.Version).ToString() - let trialPath = Path.Combine(fscoreDir0, n.Name + ".dll") + let trialPath = Path.Combine(fscoreDir0, !!n.Name + ".dll") if FileSystem.FileExistsShim trialPath then success trialPath @@ -173,7 +173,7 @@ let private SimulatedMSBuildResolver = r else try - AssemblyName(r).Name + ".dll" + !!AssemblyName(r).Name + ".dll" with _ -> r + ".dll" @@ -198,7 +198,7 @@ let private SimulatedMSBuildResolver = let netFx = System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory() let gac = - Path.Combine(Path.GetDirectoryName(Path.GetDirectoryName(netFx.TrimEnd('\\'))), "assembly") + Path.Combine(!! Path.GetDirectoryName(Path.GetDirectoryName(netFx.TrimEnd('\\'))), "assembly") match n.Version, n.GetPublicKeyToken() with | null, _ @@ -207,7 +207,7 @@ let private SimulatedMSBuildResolver = [ if FileSystem.DirectoryExistsShim gac then for gacDir in FileSystem.EnumerateDirectoriesShim gac do - let assemblyDir = Path.Combine(gacDir, n.Name) + let assemblyDir = Path.Combine(gacDir, !!n.Name) if FileSystem.DirectoryExistsShim assemblyDir then for tdir in FileSystem.EnumerateDirectoriesShim assemblyDir do @@ -228,7 +228,7 @@ let private SimulatedMSBuildResolver = if FileSystem.DirectoryExistsShim gac then for gacDir in Directory.EnumerateDirectories gac do //printfn "searching GAC directory: %s" gacDir - let assemblyDir = Path.Combine(gacDir, n.Name) + let assemblyDir = Path.Combine(gacDir, !!n.Name) if FileSystem.DirectoryExistsShim assemblyDir then //printfn "searching GAC directory: %s" assemblyDir diff --git a/src/Compiler/Facilities/prim-lexing.fs b/src/Compiler/Facilities/prim-lexing.fs index 6b927ef4a96..d1b965f100f 100644 --- a/src/Compiler/Facilities/prim-lexing.fs +++ b/src/Compiler/Facilities/prim-lexing.fs @@ -49,7 +49,7 @@ type StringText(str: string) = let mutable line = reader.ReadLine() while not (isNull line) do - yield line + yield !!line line <- reader.ReadLine() if str.EndsWith("\n", StringComparison.Ordinal) then @@ -155,7 +155,9 @@ type StringText(str: string) = sb.Append(lastLine.Substring(0, range.EndColumn)).ToString() member _.GetChecksum() = - str |> Md5Hasher.hashString |> ImmutableArray.Create + str + |> Md5Hasher.hashString + |> fun byteArray -> ImmutableArray.Create(byteArray, 0, byteArray.Length) module SourceText = @@ -190,7 +192,9 @@ module SourceTextNew = member _.GetChecksum() = // TODO: something better... - sourceText.ToString() |> Md5Hasher.hashString |> ImmutableArray.Create + !! sourceText.ToString() + |> Md5Hasher.hashString + |> fun byteArray -> ImmutableArray.Create(byteArray, 0, byteArray.Length) } // NOTE: the code in this file is a drop-in replacement runtime for Lexing.fs from the FsLexYacc repository diff --git a/src/Compiler/Interactive/ControlledExecution.fs b/src/Compiler/Interactive/ControlledExecution.fs index 24f2dcb2ae6..2d696344b58 100644 --- a/src/Compiler/Interactive/ControlledExecution.fs +++ b/src/Compiler/Interactive/ControlledExecution.fs @@ -13,6 +13,7 @@ open System.Reflection open System.Threading open Internal.Utilities.FSharpEnvironment +open Internal.Utilities.Library open Unchecked @@ -24,21 +25,20 @@ type internal ControlledExecution(isInteractive: bool) = static let ceType: Type option = Option.ofObj (Type.GetType("System.Runtime.ControlledExecution, System.Private.CoreLib", false)) - static let threadType: Type option = Option.ofObj (typeof) + static let threadType: Type option = typeof |> Option.ofObj static let ceRun: MethodInfo option = match ceType with | None -> None | Some t -> - Option.ofObj ( - t.GetMethod( - "Run", - BindingFlags.Static ||| BindingFlags.Public, - defaultof, - [| typeof; typeof |], - [||] - ) + t.GetMethod( + "Run", + BindingFlags.Static ||| BindingFlags.Public, + defaultof, + [| typeof; typeof |], + [||] ) + |> Option.ofObj static let threadResetAbort: MethodInfo option = match isRunningOnCoreClr, threadType with @@ -67,6 +67,8 @@ type internal ControlledExecution(isInteractive: bool) = static member StripTargetInvocationException(exn: Exception) = match exn with - | :? TargetInvocationException as e when not (isNull e.InnerException) -> - ControlledExecution.StripTargetInvocationException(e.InnerException) + | :? TargetInvocationException as e -> + match e.InnerException with + | null -> exn + | innerEx -> ControlledExecution.StripTargetInvocationException(innerEx) | _ -> exn diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 5904071dd8a..f16aaf6e9a1 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -374,7 +374,7 @@ type ILMultiInMemoryAssemblyEmitEnv let typT = convTypeRef tref let tyargs = List.map convTypeAux tspec.GenericArgs - let res = + let res: Type MaybeNull = match isNil tyargs, typT.IsGenericType with | _, true -> typT.MakeGenericType(List.toArray tyargs) | true, false -> typT @@ -389,7 +389,7 @@ type ILMultiInMemoryAssemblyEmitEnv and convTypeAux ty = match ty with - | ILType.Void -> Type.GetType("System.Void") + | ILType.Void -> !! Type.GetType("System.Void") | ILType.Array(shape, eltType) -> let baseT = convTypeAux eltType @@ -397,8 +397,8 @@ type ILMultiInMemoryAssemblyEmitEnv baseT.MakeArrayType() else baseT.MakeArrayType shape.Rank - | ILType.Value tspec -> convTypeSpec tspec - | ILType.Boxed tspec -> convTypeSpec tspec + | ILType.Value tspec -> !!(convTypeSpec tspec) + | ILType.Boxed tspec -> !!(convTypeSpec tspec) | ILType.Ptr eltType -> let baseT = convTypeAux eltType baseT.MakePointerType() @@ -436,7 +436,7 @@ type ILMultiInMemoryAssemblyEmitEnv let ltref = mkRefForNestedILTypeDef ILScopeRef.Local (enc, tdef) let tref = mkRefForNestedILTypeDef ilScopeRef (enc, tdef) let key = tref.BasicQualifiedName - let typ = asm.GetType(key) + let typ = !! asm.GetType(key) //printfn "Adding %s --> %s" key typ.FullName let rtref = rescopeILTypeRef dynamicCcuScopeRef tref typeMap.Add(ltref, (typ, tref)) @@ -511,7 +511,7 @@ type FsiEvaluationSessionHostConfig() = abstract FloatingPointFormat: string /// Called by the evaluation session to ask the host for parameters to format text for output - abstract AddedPrinters: Choice string), Type * (obj -> obj)> list + abstract AddedPrinters: Choice string), Type * (objnull -> objnull)> list /// Called by the evaluation session to ask the host for parameters to format text for output abstract ShowDeclarationValues: bool @@ -588,7 +588,7 @@ type FsiEvaluationSessionHostConfig() = type internal FsiValuePrinter(fsi: FsiEvaluationSessionHostConfig, outWriter: TextWriter) = /// This printer is used by F# Interactive if no other printers apply. - let DefaultPrintingIntercept (ienv: IEnvironment) (obj: obj) = + let DefaultPrintingIntercept (ienv: IEnvironment) (obj: objnull) = match obj with | null -> None | :? System.Collections.IDictionary as ie -> @@ -630,10 +630,10 @@ type internal FsiValuePrinter(fsi: FsiEvaluationSessionHostConfig, outWriter: Te match x with | Choice1Of2(aty: Type, printer) -> yield - (fun _ienv (obj: obj) -> + (fun _ienv (obj: objnull) -> match obj with | null -> None - | _ when aty.IsAssignableFrom(obj.GetType()) -> + | obj when aty.IsAssignableFrom(obj.GetType()) -> let text = printer obj match box text with @@ -643,10 +643,10 @@ type internal FsiValuePrinter(fsi: FsiEvaluationSessionHostConfig, outWriter: Te | Choice2Of2(aty: Type, converter) -> yield - (fun ienv (obj: obj) -> + (fun ienv (obj: objnull) -> match obj with | null -> None - | _ when aty.IsAssignableFrom(obj.GetType()) -> + | obj when aty.IsAssignableFrom(obj.GetType()) -> match converter obj with | null -> None | res -> Some(ienv.GetLayout res) @@ -938,8 +938,8 @@ let internal directoryName (s: string) = "." else match Path.GetDirectoryName s with - | null -> if FileSystem.IsPathRootedShim s then s else "." - | res -> if String.IsNullOrEmpty(res) then "." else res + | Null -> if FileSystem.IsPathRootedShim s then s else "." + | NonNull res -> if String.IsNullOrEmpty(res) then "." else res //---------------------------------------------------------------------------- // cmd line - state for options @@ -976,10 +976,11 @@ type internal FsiCommandLineOptions(fsi: FsiEvaluationSessionHostConfig, argv: s let executableFileNameWithoutExtension = lazy let getFsiCommandLine () = - let fileNameWithoutExtension path = Path.GetFileNameWithoutExtension(path) + let fileNameWithoutExtension (path: string MaybeNull) = Path.GetFileNameWithoutExtension(path) let currentProcess = Process.GetCurrentProcess() - let processFileName = fileNameWithoutExtension currentProcess.MainModule.FileName + let mainModule = currentProcess.MainModule + let processFileName = fileNameWithoutExtension (mainModule ^ _.FileName) let commandLineExecutableFileName = try @@ -994,7 +995,7 @@ type internal FsiCommandLineOptions(fsi: FsiEvaluationSessionHostConfig, argv: s | _ -> StringComparison.OrdinalIgnoreCase if String.Compare(processFileName, commandLineExecutableFileName, stringComparison) = 0 then - processFileName + !!processFileName else sprintf "%s %s" processFileName commandLineExecutableFileName @@ -1530,7 +1531,7 @@ let ConvReflectionTypeToILTypeRef (reflectionTy: Type) = let aref = ILAssemblyRef.FromAssemblyName(reflectionTy.Assembly.GetName()) let scoref = ILScopeRef.Assembly aref - let fullName = reflectionTy.FullName + let fullName = reflectionTy.FullName |> nullArgCheck "reflectionTy.FullName" let index = fullName.IndexOfOrdinal("[") let fullName = @@ -1569,10 +1570,10 @@ let rec ConvReflectionTypeToILType (reflectionTy: Type) = && IsCompilerGeneratedName reflectionTy.Name then let rec get (typ: Type) = - if FSharp.Reflection.FSharpType.IsFunction typ.BaseType then - get typ.BaseType - else - typ + match typ.BaseType with + | null -> typ + | baseTyp when FSharp.Reflection.FSharpType.IsFunction baseTyp -> get baseTyp + | _ -> typ get reflectionTy else @@ -1582,7 +1583,7 @@ let rec ConvReflectionTypeToILType (reflectionTy: Type) = let elementOrItemTref = if reflectionTy.HasElementType then - reflectionTy.GetElementType() + !! reflectionTy.GetElementType() else reflectionTy |> ConvReflectionTypeToILTypeRef @@ -1675,7 +1676,7 @@ let internal mkBoundValueTypedImpl tcGlobals m moduleName name ty = entity, v, CheckedImplFile.CheckedImplFile(qname, [], mty, contents, false, false, StampMap.Empty, Map.empty) let scriptingSymbolsPath = - let createDirectory path = + let createDirectory (path: string) = lazy try if not (Directory.Exists(path)) then @@ -1906,7 +1907,7 @@ type internal FsiDynamicCompiler if edef.ArgCount = 0 then yield (fun () -> - let typ = asm.GetType(edef.DeclaringTypeRef.BasicQualifiedName) + let typ = !! asm.GetType(edef.DeclaringTypeRef.BasicQualifiedName) try ignore ( @@ -1924,8 +1925,8 @@ type internal FsiDynamicCompiler ) None - with :? TargetInvocationException as e -> - Some e.InnerException) + with :? TargetInvocationException as e when isNotNull e.InnerException -> + Some !!e.InnerException) ] emEnv.AddModuleDef asm ilScopeRef ilxMainModule @@ -2418,7 +2419,7 @@ type internal FsiDynamicCompiler member _.DynamicAssemblies = dynamicAssemblies.ToArray() member _.FindDynamicAssembly(name, useFullName: bool) = - let getName (assemblyName: AssemblyName) = + let getName (assemblyName: AssemblyName) : string MaybeNull = if useFullName then assemblyName.FullName else @@ -2847,7 +2848,7 @@ type internal FsiDynamicCompiler st), (fun _ _ -> ())) - (tcConfigB, input, Path.GetDirectoryName sourceFile, istate)) + (tcConfigB, input, !! Path.GetDirectoryName(sourceFile), istate)) member fsiDynamicCompiler.EvalSourceFiles(ctok, istate, m, sourceFiles, lexResourceManager, diagnosticsLogger: DiagnosticsLogger) = let tcConfig = TcConfig.Create(tcConfigB, validate = false) @@ -2942,11 +2943,9 @@ type internal FsiDynamicCompiler | _ -> None | _ -> None - member _.AddBoundValue(ctok, diagnosticsLogger: DiagnosticsLogger, istate, name: string, value: obj) = + member _.AddBoundValue(ctok, diagnosticsLogger: DiagnosticsLogger, istate, name: string, value: objnull) = try - match value with - | null -> nullArg "value" - | _ -> () + let value = value |> nullArgCheck (nameof value) if String.IsNullOrWhiteSpace name then invalidArg "name" "Name cannot be null or white-space." @@ -3539,7 +3538,7 @@ type FsiStdinLexerProvider 0 | Some(NonNull input) -> - let input = nonNull input + "\n" + let input = input + "\n" if input.Length > len then fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiLineTooLong ()) @@ -5063,8 +5062,8 @@ module Settings = let runSignal = new AutoResetEvent(false) let exitSignal = new AutoResetEvent(false) let doneSignal = new AutoResetEvent(false) - let mutable queue = ([]: (unit -> obj) list) - let mutable result = (None: obj option) + let mutable queue = ([]: (unit -> objnull) list) + let mutable result = (None: objnull option) let setSignal (signal: AutoResetEvent) = while not (signal.Set()) do diff --git a/src/Compiler/Interactive/fsi.fsi b/src/Compiler/Interactive/fsi.fsi index 6c1bed8c418..7b7ef3b4833 100644 --- a/src/Compiler/Interactive/fsi.fsi +++ b/src/Compiler/Interactive/fsi.fsi @@ -8,6 +8,7 @@ open System.Threading open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Diagnostics open FSharp.Compiler.Symbols +open Internal.Utilities.Library /// Represents an evaluated F# value [] @@ -62,7 +63,7 @@ type public FsiEvaluationSessionHostConfig = abstract FloatingPointFormat: string /// Called by the evaluation session to ask the host for parameters to format text for output - abstract AddedPrinters: Choice string), Type * (obj -> obj)> list + abstract AddedPrinters: Choice string), Type * (objnull -> objnull)> list /// Called by the evaluation session to ask the host for parameters to format text for output abstract ShowDeclarationValues: bool @@ -396,7 +397,7 @@ module Settings = /// Register a print transformer that controls the output of the interactive session. member AddPrintTransformer: ('T -> obj) -> unit - member internal AddedPrinters: Choice string), Type * (obj -> obj)> list + member internal AddedPrinters: Choice string), Type * (objnull -> objnull)> list /// The command line arguments after ignoring the arguments relevant to the interactive /// environment and replacing the first argument with the name of the last script file, diff --git a/src/Compiler/Interactive/fsihelp.fs b/src/Compiler/Interactive/fsihelp.fs index 5b06e09e245..450701212b4 100644 --- a/src/Compiler/Interactive/fsihelp.fs +++ b/src/Compiler/Interactive/fsihelp.fs @@ -7,6 +7,10 @@ open System.Text open System.Reflection open FSharp.Compiler.IO +// 3261 Is the nullness warning. I really tried to properly check all accesses, but the chosen xml API has nulles everywhere and is not a good fit for compiler nullness checking. +// Even basic constructs like `n.Attributes.GetNamedItem("name").Value` have `| null| on every single dot access. +#nowarn "3261" + module Parser = open System.Xml diff --git a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs index 0c907d0652e..a3885384b73 100644 --- a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs +++ b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs @@ -187,21 +187,21 @@ type internal FscCompiler(legacyReferenceResolver) = let regex = Regex(@"^(/|--)test:ErrorRanges$", RegexOptions.Compiled ||| RegexOptions.IgnoreCase) - fun arg -> regex.IsMatch(arg) + fun (arg: string) -> regex.IsMatch(arg) /// test if --vserrors flag is set let vsErrorsArg = let regex = Regex(@"^(/|--)vserrors$", RegexOptions.Compiled ||| RegexOptions.IgnoreCase) - fun arg -> regex.IsMatch(arg) + fun (arg: string) -> regex.IsMatch(arg) /// test if an arg is a path to fsc.exe let fscExeArg = let regex = Regex(@"fsc(\.exe)?$", RegexOptions.Compiled ||| RegexOptions.IgnoreCase) - fun arg -> regex.IsMatch(arg) + fun (arg: string) -> regex.IsMatch(arg) /// do compilation as if args was argv to fsc.exe member _.Compile(args: string[]) = @@ -209,7 +209,7 @@ type internal FscCompiler(legacyReferenceResolver) = // compensate for this in case caller didn't know let args = match box args with - | Null -> [| "fsc" |] + | null -> [| "fsc" |] | _ -> match args with | [||] -> [| "fsc" |] diff --git a/src/Compiler/Optimize/LowerStateMachines.fs b/src/Compiler/Optimize/LowerStateMachines.fs index 97d212f8854..7a6dd553f65 100644 --- a/src/Compiler/Optimize/LowerStateMachines.fs +++ b/src/Compiler/Optimize/LowerStateMachines.fs @@ -448,7 +448,7 @@ type LowerStateMachine(g: TcGlobals) = let res = match expr with | ResumableCodeInvoke g (_, _, _, m, _) -> - Result.Error (FSComp.SR.reprResumableCodeInvokeNotReduced(m.ToString())) + Result.Error (FSComp.SR.reprResumableCodeInvokeNotReduced(!!m.ToString())) // Eliminate 'if __useResumableCode ...' within. | IfUseResumableStateMachinesExpr g (thenExpr, _) -> diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 33f56b8dd80..9d7384407e1 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -203,7 +203,10 @@ module internal FSharpCheckerResultsSettings = // Look for DLLs in the location of the service DLL first. let defaultFSharpBinariesDir = FSharpEnvironment - .BinFolderOfDefaultFSharpCompiler(Some(Path.GetDirectoryName(typeof.Assembly.Location))) + .BinFolderOfDefaultFSharpCompiler( + Path.GetDirectoryName(typeof.Assembly.Location) + |> Option.ofObj + ) .Value [] @@ -987,7 +990,7 @@ type internal TypeCheckInfo if String.IsNullOrWhiteSpace name then None else - let name = String.lowerCaseFirstChar name + let name = String.lowerCaseFirstChar !!name let unused = sResolutions.CapturedNameResolutions @@ -3019,7 +3022,7 @@ module internal ParseAndCheckFile = let parseFile ( sourceText: ISourceText, - fileName, + fileName: string, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool, @@ -3074,7 +3077,7 @@ module internal ParseAndCheckFile = ( tcConfig, parsedMainInput, - mainInputFileName, + mainInputFileName: string, loadClosure: LoadClosure option, tcImports: TcImports, backgroundDiagnostics @@ -3166,7 +3169,7 @@ module internal ParseAndCheckFile = ApplyMetaCommandsFromInputToTcConfig( tcConfig, parsedMainInput, - Path.GetDirectoryName mainInputFileName, + !! Path.GetDirectoryName(mainInputFileName), tcImports.DependencyProvider ) |> ignore @@ -3217,7 +3220,7 @@ module internal ParseAndCheckFile = // Apply nowarns to tcConfig (may generate errors, so ensure diagnosticsLogger is installed) let tcConfig = - ApplyNoWarnsToTcConfig(tcConfig, parsedMainInput, Path.GetDirectoryName mainInputFileName) + ApplyNoWarnsToTcConfig(tcConfig, parsedMainInput, !! Path.GetDirectoryName(mainInputFileName)) // update the error handler with the modified tcConfig errHandler.DiagnosticOptions <- tcConfig.diagnosticsOptions diff --git a/src/Compiler/Service/FSharpParseFileResults.fs b/src/Compiler/Service/FSharpParseFileResults.fs index 883c624804c..34958588b79 100644 --- a/src/Compiler/Service/FSharpParseFileResults.fs +++ b/src/Compiler/Service/FSharpParseFileResults.fs @@ -14,7 +14,7 @@ open FSharp.Compiler.Text open FSharp.Compiler.Text.Range module SourceFileImpl = - let IsSignatureFile file = + let IsSignatureFile (file: string) = let ext = Path.GetExtension file 0 = String.Compare(".fsi", ext, StringComparison.OrdinalIgnoreCase) diff --git a/src/Compiler/Service/FSharpProjectSnapshot.fs b/src/Compiler/Service/FSharpProjectSnapshot.fs index 8515231b836..c9293ad5cfb 100644 --- a/src/Compiler/Service/FSharpProjectSnapshot.fs +++ b/src/Compiler/Service/FSharpProjectSnapshot.fs @@ -7,6 +7,7 @@ open System.Collections.Generic open System.IO open System.Reflection open FSharp.Compiler.IO +open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Core.Printf open FSharp.Compiler.Text @@ -419,7 +420,7 @@ and internal ProjectCore member _.GetVersion() = fullHashString.Value }) - member val ProjectDirectory = Path.GetDirectoryName(ProjectFileName) + member val ProjectDirectory = !! Path.GetDirectoryName(ProjectFileName) member _.OutputFileName = outputFileName.Value member _.Identifier: ProjectIdentifier = key.Value member _.Version = fullHash.Value diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 43a7a9cde96..8d610c0aa71 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -142,7 +142,7 @@ module IncrementalBuildSyntaxTree = Activity.start "IncrementalBuildSyntaxTree.parse" [| Activity.Tags.fileName, fileName - Activity.Tags.buildPhase, BuildPhase.Parse.ToString() + Activity.Tags.buildPhase, !! BuildPhase.Parse.ToString() |] try @@ -264,7 +264,7 @@ type BoundModel private ( beforeFileChecked.Trigger fileName - ApplyMetaCommandsFromInputToTcConfig (tcConfig, input, Path.GetDirectoryName fileName, tcImports.DependencyProvider) |> ignore + ApplyMetaCommandsFromInputToTcConfig (tcConfig, input, !! Path.GetDirectoryName(fileName), tcImports.DependencyProvider) |> ignore let sink = TcResultsSinkImpl(tcGlobals) let hadParseErrors = not (Array.isEmpty parseErrors) let input, moduleNamesDict = DeduplicateParsedInputModuleName prevTcInfo.moduleNamesDict input @@ -805,7 +805,7 @@ module IncrementalBuilderHelpers = let hasTypeProviderAssemblyAttrib = topAttrs.assemblyAttrs |> List.exists (fun (Attrib(tcref, _, _, _, _, _, _)) -> let nm = tcref.CompiledRepresentationForNamedType.BasicQualifiedName - nm = typeof.FullName) + nm = !! typeof.FullName) if tcState.CreatesGeneratedProvidedTypes || hasTypeProviderAssemblyAttrib then ProjectAssemblyDataResult.Unavailable true @@ -1455,7 +1455,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc { new IXmlDocumentationInfoLoader with /// Try to load xml documentation associated with an assembly by the same file path with the extension ".xml". member _.TryLoad(assemblyFileName) = - let xmlFileName = Path.ChangeExtension(assemblyFileName, ".xml") + let xmlFileName = !! Path.ChangeExtension(assemblyFileName, ".xml") // REVIEW: File IO - Will eventually need to change this to use a file system interface of some sort. XmlDocumentationInfo.TryCreateFromFile(xmlFileName) diff --git a/src/Compiler/Service/ItemKey.fs b/src/Compiler/Service/ItemKey.fs index 7a904a235ed..3c030f84c90 100644 --- a/src/Compiler/Service/ItemKey.fs +++ b/src/Compiler/Service/ItemKey.fs @@ -7,6 +7,7 @@ open System.IO open System.IO.MemoryMappedFiles open System.Reflection.Metadata open System.Runtime.InteropServices +open Internal.Utilities.Library open FSharp.NativeInterop open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.Infos @@ -436,7 +437,7 @@ and [] ItemKeyStoreBuilder(tcGlobals: TcGlobals) = writeString ItemKeyTags.itemActivePattern match apInfo.ActiveTagsWithRanges with - | (_, m) :: _ -> m.FileName |> Path.GetFileNameWithoutExtension |> writeString + | (_, m) :: _ -> m.FileName |> Path.GetFileNameWithoutExtension |> (!!) |> writeString | _ -> () for tag in apInfo.ActiveTags do diff --git a/src/Compiler/Service/ServiceDeclarationLists.fs b/src/Compiler/Service/ServiceDeclarationLists.fs index 39dcb183028..451c815a6a4 100644 --- a/src/Compiler/Service/ServiceDeclarationLists.fs +++ b/src/Compiler/Service/ServiceDeclarationLists.fs @@ -121,7 +121,7 @@ module DeclarationListHelpers = { new IPartialEqualityComparer with member x.InEqualityRelation item = itemComparer.InEqualityRelation item.Item - member x.Equals(item1, item2) = itemComparer.Equals(item1.Item, item2.Item) + member x.Equals(item1, item2) = nullSafeEquality item1 item2 (fun item1 item2 -> itemComparer.Equals(item1.Item, item2.Item)) member x.GetHashCode item = itemComparer.GetHashCode(item.Item) } /// Remove all duplicate items @@ -138,7 +138,7 @@ module DeclarationListHelpers = modrefs |> IPartialEqualityComparer.partialDistinctBy { new IPartialEqualityComparer with member x.InEqualityRelation _ = true - member x.Equals(item1, item2) = (fullDisplayTextOfModRef item1 = fullDisplayTextOfModRef item2) + member x.Equals(item1, item2) = nullSafeEquality item1 item2 (fun item1 item2 -> fullDisplayTextOfModRef item1 = fullDisplayTextOfModRef item2) member x.GetHashCode item = hash item.Stamp } let OutputFullName displayFullName ppF fnF r = @@ -671,7 +671,7 @@ module internal DescriptionListsImpl = |> Array.map (fun sp -> let ty = Import.ImportProvidedType amap m (sp.PApply((fun x -> x.ParameterType), m)) let spKind = NicePrint.prettyLayoutOfType denv ty - let spName = sp.PUntaint((fun sp -> nonNull sp.Name), m) + let spName = sp.PUntaint((fun sp -> sp.Name), m) let spOpt = sp.PUntaint((fun sp -> sp.IsOptional), m) let display = (if spOpt then SepL.questionMark else emptyL) ^^ wordL (tagParameter spName) ^^ RightL.colon ^^ spKind let display = toArray display diff --git a/src/Compiler/Service/ServiceInterfaceStubGenerator.fs b/src/Compiler/Service/ServiceInterfaceStubGenerator.fs index e02df4c7da7..10ea474f791 100644 --- a/src/Compiler/Service/ServiceInterfaceStubGenerator.fs +++ b/src/Compiler/Service/ServiceInterfaceStubGenerator.fs @@ -41,7 +41,7 @@ module internal CodeGenerationUtils = member _.Unindent i = indentWriter.Indent <- max 0 (indentWriter.Indent - i) - member _.Dump() = indentWriter.InnerWriter.ToString() + member _.Dump() = !! indentWriter.InnerWriter.ToString() interface IDisposable with member _.Dispose() = diff --git a/src/Compiler/Service/ServiceParsedInputOps.fs b/src/Compiler/Service/ServiceParsedInputOps.fs index 9881ac7ef75..24fcf3bc727 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -17,7 +17,7 @@ open FSharp.Compiler.Text.Position open FSharp.Compiler.Text.Range module SourceFileImpl = - let IsSignatureFile file = + let IsSignatureFile (file: string) = let ext = Path.GetExtension file 0 = String.Compare(".fsi", ext, StringComparison.OrdinalIgnoreCase) diff --git a/src/Compiler/Service/SynExpr.fs b/src/Compiler/Service/SynExpr.fs index a5904621ca6..e9605582514 100644 --- a/src/Compiler/Service/SynExpr.fs +++ b/src/Compiler/Service/SynExpr.fs @@ -519,7 +519,7 @@ module SynExpr = if startLine = endLine then range.StartColumn <= outerOffsidesColumn else - let rec loop offsides lineNo startCol = + let rec loop offsides lineNo (startCol: int) = if lineNo <= endLine then let line = getSourceLineStr lineNo diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index 734dd2a1eee..bd7c8375288 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -808,7 +808,7 @@ type internal TransparentCompiler { new IXmlDocumentationInfoLoader with /// Try to load xml documentation associated with an assembly by the same file path with the extension ".xml". member _.TryLoad(assemblyFileName) = - let xmlFileName = Path.ChangeExtension(assemblyFileName, ".xml") + let xmlFileName = !! Path.ChangeExtension(assemblyFileName, ".xml") // REVIEW: File IO - Will eventually need to change this to use a file system interface of some sort. XmlDocumentationInfo.TryCreateFromFile(xmlFileName) @@ -834,7 +834,7 @@ type internal TransparentCompiler Activity.start "ComputeBootstrapInfoStatic" [| - Activity.Tags.project, projectSnapshot.ProjectFileName |> Path.GetFileName + Activity.Tags.project, projectSnapshot.ProjectFileName |> Path.GetFileName |> (!!) "references", projectSnapshot.ReferencedProjects.Length.ToString() |] @@ -988,7 +988,11 @@ type internal TransparentCompiler projectSnapshot.NoFileVersionsKey, async { use _ = - Activity.start "ComputeBootstrapInfo" [| Activity.Tags.project, projectSnapshot.ProjectFileName |> Path.GetFileName |] + Activity.start + "ComputeBootstrapInfo" + [| + Activity.Tags.project, projectSnapshot.ProjectFileName |> Path.GetFileName |> (!!) + |] // Trap and report diagnostics from creation. let delayedLogger = CapturingDiagnosticsLogger("IncrementalBuilderCreation") @@ -1156,8 +1160,9 @@ type internal TransparentCompiler //Trace.TraceInformation("\n" + debugGraph) - if Activity.Current <> null then - Activity.Current.AddTag("graph", debugGraph) |> ignore + match Activity.Current with + | Null -> () + | NonNull a -> a.AddTag("graph", debugGraph) |> ignore return nodeGraph, graph } @@ -1261,7 +1266,7 @@ type internal TransparentCompiler Activity.start "ComputeTcIntermediate" [| - Activity.Tags.fileName, fileName |> Path.GetFileName + Activity.Tags.fileName, fileName |> Path.GetFileName |> (!!) "key", key.GetLabel() "version", "-" // key.GetVersion() |] @@ -1289,7 +1294,7 @@ type internal TransparentCompiler // Apply nowarns to tcConfig (may generate errors, so ensure diagnosticsLogger is installed) let tcConfig = - ApplyNoWarnsToTcConfig(tcConfig, parsedMainInput, Path.GetDirectoryName mainInputFileName) + ApplyNoWarnsToTcConfig(tcConfig, parsedMainInput, !! Path.GetDirectoryName(mainInputFileName)) let diagnosticsLogger = errHandler.DiagnosticsLogger @@ -1300,7 +1305,7 @@ type internal TransparentCompiler //beforeFileChecked.Trigger fileName - ApplyMetaCommandsFromInputToTcConfig(tcConfig, input, Path.GetDirectoryName fileName, tcImports.DependencyProvider) + ApplyMetaCommandsFromInputToTcConfig(tcConfig, input, Path.GetDirectoryName fileName |> (!!), tcImports.DependencyProvider) |> ignore let sink = TcResultsSinkImpl(tcGlobals, file.SourceText) @@ -1473,7 +1478,7 @@ type internal TransparentCompiler let file = projectSnapshot.SourceFiles |> List.last use _ = - Activity.start "ComputeTcLastFile" [| Activity.Tags.fileName, file.FileName |> Path.GetFileName |] + Activity.start "ComputeTcLastFile" [| Activity.Tags.fileName, file.FileName |> Path.GetFileName |> (!!) |] let! projectSnapshot = parseSourceFiles projectSnapshot bootstrapInfo.TcConfig @@ -1527,7 +1532,7 @@ type internal TransparentCompiler projectSnapshot.FileKeyWithExtraFileSnapshotVersion fileName, async { use _ = - Activity.start "ComputeParseAndCheckFileInProject" [| Activity.Tags.fileName, fileName |> Path.GetFileName |] + Activity.start "ComputeParseAndCheckFileInProject" [| Activity.Tags.fileName, fileName |> Path.GetFileName |> (!!) |] match! ComputeBootstrapInfo projectSnapshot with | None, creationDiags -> return emptyParseResult fileName creationDiags, FSharpCheckFileAnswer.Aborted @@ -1559,7 +1564,7 @@ type internal TransparentCompiler // Apply nowarns to tcConfig (may generate errors, so ensure diagnosticsLogger is installed) let tcConfig = - ApplyNoWarnsToTcConfig(bootstrapInfo.TcConfig, parseResults.ParseTree, Path.GetDirectoryName fileName) + ApplyNoWarnsToTcConfig(bootstrapInfo.TcConfig, parseResults.ParseTree, Path.GetDirectoryName fileName |> (!!)) let diagnosticsOptions = tcConfig.diagnosticsOptions @@ -1641,7 +1646,9 @@ type internal TransparentCompiler use _ = Activity.start "ComputeParseAndCheckAllFilesInProject" - [| Activity.Tags.project, projectSnapshot.ProjectFileName |> Path.GetFileName |] + [| + Activity.Tags.project, projectSnapshot.ProjectFileName |> Path.GetFileName |> (!!) + |] let! projectSnapshot = parseSourceFiles projectSnapshot bootstrapInfo.TcConfig @@ -1746,7 +1753,7 @@ type internal TransparentCompiler |> List.exists (fun (Attrib(tcref, _, _, _, _, _, _)) -> let nm = tcref.CompiledRepresentationForNamedType.BasicQualifiedName - nm = typeof.FullName) + nm = !!typeof.FullName) if tcState.CreatesGeneratedProvidedTypes || hasTypeProviderAssemblyAttrib then ProjectAssemblyDataResult.Unavailable true @@ -1912,7 +1919,7 @@ type internal TransparentCompiler projectSnapshot.FileKey fileName, async { use _ = - Activity.start "ComputeSemanticClassification" [| Activity.Tags.fileName, fileName |> Path.GetFileName |] + Activity.start "ComputeSemanticClassification" [| Activity.Tags.fileName, fileName |> Path.GetFileName |> (!!) |] let! sinkOpt = tryGetSink fileName projectSnapshot @@ -1942,7 +1949,7 @@ type internal TransparentCompiler projectSnapshot.FileKey fileName, async { use _ = - Activity.start "ComputeItemKeyStore" [| Activity.Tags.fileName, fileName |> Path.GetFileName |] + Activity.start "ComputeItemKeyStore" [| Activity.Tags.fileName, fileName |> Path.GetFileName |> (!!) |] let! sinkOpt = tryGetSink fileName projectSnapshot diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 5a1535b6f2d..f02495545ab 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -751,14 +751,14 @@ type CompilerEnvironment() = static member IsScriptFile(fileName: string) = ParseAndCheckInputs.IsScript fileName /// Whether or not this file is compilable - static member IsCompilable file = + static member IsCompilable(file: string) = let ext = Path.GetExtension file compilableExtensions |> List.exists (fun e -> 0 = String.Compare(e, ext, StringComparison.OrdinalIgnoreCase)) /// Whether or not this file should be a single-file project - static member MustBeSingleFileProject file = + static member MustBeSingleFileProject(file: string) = let ext = Path.GetExtension file singleFileProjectExtensions diff --git a/src/Compiler/Symbols/SymbolHelpers.fs b/src/Compiler/Symbols/SymbolHelpers.fs index 8a9300ea82b..0e5d0ff8475 100644 --- a/src/Compiler/Symbols/SymbolHelpers.fs +++ b/src/Compiler/Symbols/SymbolHelpers.fs @@ -254,7 +254,7 @@ module internal SymbolHelpers = | FSharpXmlDoc.None | FSharpXmlDoc.FromXmlText _ -> xmlDoc | FSharpXmlDoc.FromXmlFile(dllName, xmlSig) -> - TryFindXmlDocByAssemblyNameAndSig infoReader (Path.GetFileNameWithoutExtension dllName) xmlSig + TryFindXmlDocByAssemblyNameAndSig infoReader (!!Path.GetFileNameWithoutExtension(dllName)) xmlSig |> Option.map FSharpXmlDoc.FromXmlText |> Option.defaultValue xmlDoc @@ -406,66 +406,72 @@ module internal SymbolHelpers = //| _ -> false member x.Equals(item1, item2) = - // This may explore assemblies that are not in the reference set. - // In this case just bail out and assume items are not equal - protectAssemblyExploration false (fun () -> - let equalHeadTypes(ty1, ty2) = - match tryTcrefOfAppTy g ty1 with - | ValueSome tcref1 -> - match tryTcrefOfAppTy g ty2 with - | ValueSome tcref2 -> tyconRefEq g tcref1 tcref2 - | _ -> typeEquiv g ty1 ty2 - | _ -> typeEquiv g ty1 ty2 - - ItemsAreEffectivelyEqual g item1 item2 || - - // Much of this logic is already covered by 'ItemsAreEffectivelyEqual' - match item1, item2 with - | Item.DelegateCtor ty1, Item.DelegateCtor ty2 -> equalHeadTypes(ty1, ty2) - | Item.Types(dn1, ty1 :: _), Item.Types(dn2, ty2 :: _) -> - // Bug 4403: We need to compare names as well, because 'int' and 'Int32' are physically the same type, but we want to show both - dn1 = dn2 && equalHeadTypes(ty1, ty2) +#if !NO_CHECKNULLS + match item1,item2 with + | null,null -> true + | null,_ | _,null -> false + | item1,item2 -> +#endif + // This may explore assemblies that are not in the reference set. + // In this case just bail out and assume items are not equal + protectAssemblyExploration false (fun () -> + let equalHeadTypes(ty1, ty2) = + match tryTcrefOfAppTy g ty1 with + | ValueSome tcref1 -> + match tryTcrefOfAppTy g ty2 with + | ValueSome tcref2 -> tyconRefEq g tcref1 tcref2 + | _ -> typeEquiv g ty1 ty2 + | _ -> typeEquiv g ty1 ty2 + + ItemsAreEffectivelyEqual g item1 item2 || + + // Much of this logic is already covered by 'ItemsAreEffectivelyEqual' + match item1, item2 with + | Item.DelegateCtor ty1, Item.DelegateCtor ty2 -> equalHeadTypes(ty1, ty2) + | Item.Types(dn1, ty1 :: _), Item.Types(dn2, ty2 :: _) -> + // Bug 4403: We need to compare names as well, because 'int' and 'Int32' are physically the same type, but we want to show both + dn1 = dn2 && equalHeadTypes(ty1, ty2) - // Prefer a type to a DefaultStructCtor, a DelegateCtor and a FakeInterfaceCtor - | ItemWhereTypIsPreferred ty1, ItemWhereTypIsPreferred ty2 -> equalHeadTypes(ty1, ty2) - - | Item.ExnCase tcref1, Item.ExnCase tcref2 -> tyconRefEq g tcref1 tcref2 - | Item.ILField(fld1), Item.ILField(fld2) -> - ILFieldInfo.ILFieldInfosUseIdenticalDefinitions fld1 fld2 - | Item.CustomOperation (_, _, Some minfo1), Item.CustomOperation (_, _, Some minfo2) -> - MethInfo.MethInfosUseIdenticalDefinitions minfo1 minfo2 - | Item.TypeVar (nm1, tp1), Item.TypeVar (nm2, tp2) -> - (nm1 = nm2) && typarRefEq tp1 tp2 - | Item.ModuleOrNamespaces(modref1 :: _), Item.ModuleOrNamespaces(modref2 :: _) -> fullDisplayTextOfModRef modref1 = fullDisplayTextOfModRef modref2 - | Item.SetterArg(id1, _), Item.SetterArg(id2, _) -> Range.equals id1.idRange id2.idRange && id1.idText = id2.idText - | Item.MethodGroup(_, meths1, _), Item.MethodGroup(_, meths2, _) -> - Seq.zip meths1 meths2 |> Seq.forall (fun (minfo1, minfo2) -> - MethInfo.MethInfosUseIdenticalDefinitions minfo1 minfo2) - | (Item.Value vref1 | Item.CustomBuilder (_, vref1)), (Item.Value vref2 | Item.CustomBuilder (_, vref2)) -> - valRefEq g vref1 vref2 - | Item.ActivePatternCase(APElemRef(_apinfo1, vref1, idx1, _)), Item.ActivePatternCase(APElemRef(_apinfo2, vref2, idx2, _)) -> - idx1 = idx2 && valRefEq g vref1 vref2 - | Item.UnionCase(UnionCaseInfo(_, ur1), _), Item.UnionCase(UnionCaseInfo(_, ur2), _) -> - g.unionCaseRefEq ur1 ur2 - | Item.RecdField(RecdFieldInfo(_, RecdFieldRef(tcref1, n1))), Item.RecdField(RecdFieldInfo(_, RecdFieldRef(tcref2, n2))) -> - (tyconRefEq g tcref1 tcref2) && (n1 = n2) // there is no direct function as in the previous case - | Item.Property(info = pi1s), Item.Property(info = pi2s) -> - (pi1s, pi2s) ||> List.forall2 PropInfo.PropInfosUseIdenticalDefinitions - | Item.Event evt1, Item.Event evt2 -> - EventInfo.EventInfosUseIdenticalDefinitions evt1 evt2 - | Item.AnonRecdField(anon1, _, i1, _), Item.AnonRecdField(anon2, _, i2, _) -> - anonInfoEquiv anon1 anon2 && i1 = i2 - | Item.Trait traitInfo1, Item.Trait traitInfo2 -> - (traitInfo1.MemberLogicalName = traitInfo2.MemberLogicalName) - | Item.CtorGroup(_, meths1), Item.CtorGroup(_, meths2) -> - (meths1, meths2) - ||> List.forall2 MethInfo.MethInfosUseIdenticalDefinitions - | Item.UnqualifiedType tcrefs1, Item.UnqualifiedType tcrefs2 -> - (tcrefs1, tcrefs2) - ||> List.forall2 (fun tcref1 tcref2 -> tyconRefEq g tcref1 tcref2) - | Item.Types(_, [AbbrevOrAppTy(tcref1, _)]), Item.UnqualifiedType([tcref2]) -> tyconRefEq g tcref1 tcref2 - | Item.UnqualifiedType([tcref1]), Item.Types(_, [AbbrevOrAppTy(tcref2, _)]) -> tyconRefEq g tcref1 tcref2 - | _ -> false) + // Prefer a type to a DefaultStructCtor, a DelegateCtor and a FakeInterfaceCtor + | ItemWhereTypIsPreferred ty1, ItemWhereTypIsPreferred ty2 -> equalHeadTypes(ty1, ty2) + + | Item.ExnCase tcref1, Item.ExnCase tcref2 -> tyconRefEq g tcref1 tcref2 + | Item.ILField(fld1), Item.ILField(fld2) -> + ILFieldInfo.ILFieldInfosUseIdenticalDefinitions fld1 fld2 + | Item.CustomOperation (_, _, Some minfo1), Item.CustomOperation (_, _, Some minfo2) -> + MethInfo.MethInfosUseIdenticalDefinitions minfo1 minfo2 + | Item.TypeVar (nm1, tp1), Item.TypeVar (nm2, tp2) -> + (nm1 = nm2) && typarRefEq tp1 tp2 + | Item.ModuleOrNamespaces(modref1 :: _), Item.ModuleOrNamespaces(modref2 :: _) -> fullDisplayTextOfModRef modref1 = fullDisplayTextOfModRef modref2 + | Item.SetterArg(id1, _), Item.SetterArg(id2, _) -> Range.equals id1.idRange id2.idRange && id1.idText = id2.idText + | Item.MethodGroup(_, meths1, _), Item.MethodGroup(_, meths2, _) -> + Seq.zip meths1 meths2 |> Seq.forall (fun (minfo1, minfo2) -> + MethInfo.MethInfosUseIdenticalDefinitions minfo1 minfo2) + | (Item.Value vref1 | Item.CustomBuilder (_, vref1)), (Item.Value vref2 | Item.CustomBuilder (_, vref2)) -> + valRefEq g vref1 vref2 + | Item.ActivePatternCase(APElemRef(_apinfo1, vref1, idx1, _)), Item.ActivePatternCase(APElemRef(_apinfo2, vref2, idx2, _)) -> + idx1 = idx2 && valRefEq g vref1 vref2 + | Item.UnionCase(UnionCaseInfo(_, ur1), _), Item.UnionCase(UnionCaseInfo(_, ur2), _) -> + g.unionCaseRefEq ur1 ur2 + | Item.RecdField(RecdFieldInfo(_, RecdFieldRef(tcref1, n1))), Item.RecdField(RecdFieldInfo(_, RecdFieldRef(tcref2, n2))) -> + (tyconRefEq g tcref1 tcref2) && (n1 = n2) // there is no direct function as in the previous case + | Item.Property(info = pi1s), Item.Property(info = pi2s) -> + (pi1s, pi2s) ||> List.forall2 PropInfo.PropInfosUseIdenticalDefinitions + | Item.Event evt1, Item.Event evt2 -> + EventInfo.EventInfosUseIdenticalDefinitions evt1 evt2 + | Item.AnonRecdField(anon1, _, i1, _), Item.AnonRecdField(anon2, _, i2, _) -> + anonInfoEquiv anon1 anon2 && i1 = i2 + | Item.Trait traitInfo1, Item.Trait traitInfo2 -> + (traitInfo1.MemberLogicalName = traitInfo2.MemberLogicalName) + | Item.CtorGroup(_, meths1), Item.CtorGroup(_, meths2) -> + (meths1, meths2) + ||> List.forall2 MethInfo.MethInfosUseIdenticalDefinitions + | Item.UnqualifiedType tcrefs1, Item.UnqualifiedType tcrefs2 -> + (tcrefs1, tcrefs2) + ||> List.forall2 (fun tcref1 tcref2 -> tyconRefEq g tcref1 tcref2) + | Item.Types(_, [AbbrevOrAppTy(tcref1, _)]), Item.UnqualifiedType([tcref2]) -> tyconRefEq g tcref1 tcref2 + | Item.UnqualifiedType([tcref1]), Item.Types(_, [AbbrevOrAppTy(tcref2, _)]) -> tyconRefEq g tcref1 tcref2 + | _ -> false) member x.GetHashCode item = // This may explore assemblies that are not in the reference set. diff --git a/src/Compiler/SyntaxTree/LexHelpers.fs b/src/Compiler/SyntaxTree/LexHelpers.fs index 02d4da364d4..8bcae32d782 100644 --- a/src/Compiler/SyntaxTree/LexHelpers.fs +++ b/src/Compiler/SyntaxTree/LexHelpers.fs @@ -477,13 +477,14 @@ module Keywords = fileName |> FileSystem.GetFullPathShim (* asserts that path is already absolute *) |> System.IO.Path.GetDirectoryName + |> (!!) if String.IsNullOrEmpty dirname then dirname else PathMap.applyDir args.pathMap dirname |> fun dir -> KEYWORD_STRING(s, dir) - | "__SOURCE_FILE__" -> KEYWORD_STRING(s, System.IO.Path.GetFileName(FileIndex.fileOfFileIndex lexbuf.StartPos.FileIndex)) + | "__SOURCE_FILE__" -> KEYWORD_STRING(s, !! System.IO.Path.GetFileName(FileIndex.fileOfFileIndex lexbuf.StartPos.FileIndex)) | "__LINE__" -> KEYWORD_STRING(s, string lexbuf.StartPos.Line) | _ -> IdentifierToken args lexbuf s diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fs b/src/Compiler/SyntaxTree/ParseHelpers.fs index 3f6c12dd217..e3f5e3796db 100644 --- a/src/Compiler/SyntaxTree/ParseHelpers.fs +++ b/src/Compiler/SyntaxTree/ParseHelpers.fs @@ -75,7 +75,7 @@ type IParseState with match bls.TryGetValue key with | true, gen -> gen | _ -> - let gen = box (SynArgNameGenerator()) + let gen = !!(box (SynArgNameGenerator())) bls[key] <- gen gen @@ -97,7 +97,7 @@ module LexbufLocalXmlDocStore = match lexbuf.BufferLocalStore.TryGetValue xmlDocKey with | true, collector -> collector | _ -> - let collector = box (XmlDocCollector()) + let collector = !!(box (XmlDocCollector())) lexbuf.BufferLocalStore[xmlDocKey] <- collector collector @@ -188,7 +188,7 @@ module LexbufIfdefStore = match lexbuf.BufferLocalStore.TryGetValue ifDefKey with | true, store -> store | _ -> - let store = box (ResizeArray()) + let store = !!(box (ResizeArray())) lexbuf.BufferLocalStore[ifDefKey] <- store store |> unbox> @@ -237,7 +237,7 @@ module LexbufCommentStore = match lexbuf.BufferLocalStore.TryGetValue commentKey with | true, store -> store | _ -> - let store = box (ResizeArray()) + let store = !!(box (ResizeArray())) lexbuf.BufferLocalStore[commentKey] <- store store |> unbox> @@ -894,7 +894,7 @@ let mkRecdField (lidwd: SynLongIdent) = lidwd, true // Used for 'do expr' in a class. let mkSynDoBinding (vis: SynAccess option, mDo, expr, m) = match vis with - | Some vis -> errorR (Error(FSComp.SR.parsDoCannotHaveVisibilityDeclarations (vis.ToString()), m)) + | Some vis -> errorR (Error(FSComp.SR.parsDoCannotHaveVisibilityDeclarations (vis |> string), m)) | None -> () SynBinding( diff --git a/src/Compiler/SyntaxTree/PrettyNaming.fs b/src/Compiler/SyntaxTree/PrettyNaming.fs index 51f4c3b786a..92029a21da1 100755 --- a/src/Compiler/SyntaxTree/PrettyNaming.fs +++ b/src/Compiler/SyntaxTree/PrettyNaming.fs @@ -363,6 +363,8 @@ let IsOperatorDisplayName (name: string) = let IsPossibleOpName (name: string) = name.StartsWithOrdinal(opNamePrefix) +let ordinalStringComparer: IEqualityComparer = StringComparer.Ordinal + /// Compiles a custom operator into a mangled operator name. /// For example, "!%" becomes "op_DereferencePercent". /// This function should only be used for custom operators @@ -387,7 +389,7 @@ let compileCustomOpName = /// Memoize compilation of custom operators. /// They're typically used more than once so this avoids some CPU and GC overhead. - let compiledOperators = ConcurrentDictionary<_, string> StringComparer.Ordinal + let compiledOperators = ConcurrentDictionary ordinalStringComparer // Cache this as a delegate. let compiledOperatorsAddDelegate = @@ -416,7 +418,7 @@ let compileCustomOpName = /// Maps the built-in F# operators to their mangled operator names. let standardOpNames = - let opNames = Dictionary<_, _>(opNameTable.Length, StringComparer.Ordinal) + let opNames = Dictionary<_, _>(opNameTable.Length, ordinalStringComparer) for x, y in opNameTable do opNames.Add(x, y) @@ -440,7 +442,7 @@ let CompileOpName op = let decompileCustomOpName = // Memoize this operation. Custom operators are typically used more than once // so this avoids repeating decompilation. - let decompiledOperators = ConcurrentDictionary<_, _> StringComparer.Ordinal + let decompiledOperators = ConcurrentDictionary<_, _> ordinalStringComparer /// The minimum length of the name for a custom operator character. /// This value is used when initializing StringBuilders to avoid resizing. @@ -507,7 +509,7 @@ let decompileCustomOpName = /// Maps the mangled operator names of built-in F# operators back to the operators. let standardOpsDecompile = - let ops = Dictionary(opNameTable.Length, StringComparer.Ordinal) + let ops = Dictionary(opNameTable.Length, ordinalStringComparer) for x, y in opNameTable do ops.Add(y, x) @@ -624,7 +626,7 @@ let IsValidPrefixOperatorUse s = if String.IsNullOrEmpty s then false else - match s with + match !!s with | "?+" | "?-" | "+" @@ -635,12 +637,13 @@ let IsValidPrefixOperatorUse s = | "%%" | "&" | "&&" -> true - | _ -> s[0] = '!' || isTildeOnlyString s + | s -> s[0] = '!' || isTildeOnlyString s let IsValidPrefixOperatorDefinitionName s = if String.IsNullOrEmpty s then false else + let s = !!s match s[0] with | '~' -> @@ -667,8 +670,8 @@ let IsLogicalPrefixOperator logicalName = if String.IsNullOrEmpty logicalName then false else - let displayName = ConvertValLogicalNameToDisplayNameCore logicalName - displayName <> logicalName && IsValidPrefixOperatorDefinitionName displayName + let displayName = ConvertValLogicalNameToDisplayNameCore !!logicalName + displayName <> !!logicalName && IsValidPrefixOperatorDefinitionName displayName let IsLogicalTernaryOperator logicalName = let displayName = ConvertValLogicalNameToDisplayNameCore logicalName diff --git a/src/Compiler/SyntaxTree/XmlDoc.fs b/src/Compiler/SyntaxTree/XmlDoc.fs index 16de1a4b32c..a366a69a8a6 100644 --- a/src/Compiler/SyntaxTree/XmlDoc.fs +++ b/src/Compiler/SyntaxTree/XmlDoc.fs @@ -79,7 +79,7 @@ type XmlDoc(unprocessedLines: string[], range: range) = | Some paramNames -> for p in xml.Descendants(XName.op_Implicit "param") do - match p.Attribute(XName.op_Implicit "name") with + match p.Attribute(!!(XName.op_Implicit "name")) with | null -> warning (Error(FSComp.SR.xmlDocMissingParameterName (), doc.Range)) | attr -> let nm = attr.Value @@ -90,9 +90,9 @@ type XmlDoc(unprocessedLines: string[], range: range) = let paramsWithDocs = [ for p in xml.Descendants(XName.op_Implicit "param") do - match p.Attribute(XName.op_Implicit "name") with - | null -> () - | attr -> attr.Value + match p.Attribute(!!(XName.op_Implicit "name")) with + | Null -> () + | NonNull attr -> attr.Value ] if paramsWithDocs.Length > 0 then @@ -107,7 +107,7 @@ type XmlDoc(unprocessedLines: string[], range: range) = warning (Error(FSComp.SR.xmlDocDuplicateParameter (d), doc.Range)) for pref in xml.Descendants(XName.op_Implicit "paramref") do - match pref.Attribute(XName.op_Implicit "name") with + match pref.Attribute(!!(XName.op_Implicit "name")) with | null -> warning (Error(FSComp.SR.xmlDocMissingParameterName (), doc.Range)) | attr -> let nm = attr.Value @@ -307,7 +307,7 @@ type XmlDocumentationInfo private (tryGetXmlDocument: unit -> XmlDocument option let lines = Array.zeroCreate childNodes.Count for i = 0 to childNodes.Count - 1 do - let childNode = childNodes[i] + let childNode = !!childNodes[i] lines[i] <- childNode.OuterXml XmlDoc(lines, range0)) diff --git a/src/Compiler/TypedTree/QuotationPickler.fs b/src/Compiler/TypedTree/QuotationPickler.fs index 4c613f007d2..f2a58203ec6 100644 --- a/src/Compiler/TypedTree/QuotationPickler.fs +++ b/src/Compiler/TypedTree/QuotationPickler.fs @@ -249,7 +249,11 @@ let PickleBufferCapacity = 100000 module SimplePickle = - type Table<'T> = + type Table<'T +#if !NO_CHECKNULLS + when 'T:not null +#endif + > = { tbl: HashMultiMap<'T, int> // This should be "Dictionary" mutable rows: 'T list mutable count: int } diff --git a/src/Compiler/TypedTree/TypeProviders.fs b/src/Compiler/TypedTree/TypeProviders.fs index 2978db62fd7..d5850ca442e 100644 --- a/src/Compiler/TypedTree/TypeProviders.fs +++ b/src/Compiler/TypedTree/TypeProviders.fs @@ -49,7 +49,7 @@ let GetTypeProviderImplementationTypes ( // Report an error, blaming the particular type provider component let raiseError designTimeAssemblyPathOpt (e: exn) = let attrName = typeof.Name - let exnTypeName = e.GetType().FullName + let exnTypeName = !! e.GetType().FullName let exnMsg = e.Message match designTimeAssemblyPathOpt with | None -> @@ -69,16 +69,13 @@ let GetTypeProviderImplementationTypes ( [ for t in exportedTypes do let ca = t.GetCustomAttributes(typeof, true) - match ca with - | Null -> () - | NonNull ca -> - if ca.Length > 0 then - yield t + if ca.Length > 0 then + yield t ] filtered with e -> - let folder = Path.GetDirectoryName loadedDesignTimeAssembly.Location - let exnTypeName = e.GetType().FullName + let folder = !! Path.GetDirectoryName(loadedDesignTimeAssembly.Location) + let exnTypeName = !! e.GetType().FullName let exnMsg = e.Message match e with | :? FileLoadException -> @@ -92,8 +89,8 @@ let GetTypeProviderImplementationTypes ( let StripException (e: exn) = match e with - | :? TargetInvocationException as e -> e.InnerException - | :? TypeInitializationException as e -> e.InnerException + | :? TargetInvocationException as e when isNotNull e.InnerException -> !! e.InnerException + | :? TypeInitializationException as e when isNotNull e.InnerException -> !! e.InnerException | _ -> e /// Create an instance of a type provider from the implementation type for the type provider in the @@ -116,7 +113,7 @@ let CreateTypeProvider ( f () with err -> let e = StripException (StripException err) - raise (TypeProviderError(FSComp.SR.etTypeProviderConstructorException(e.Message), typeProviderImplementationType.FullName, m)) + raise (TypeProviderError(FSComp.SR.etTypeProviderConstructorException(e.Message), !! typeProviderImplementationType.FullName, m)) let getReferencedAssemblies () = resolutionEnvironment.GetReferencedAssemblies() |> Array.distinct @@ -151,7 +148,7 @@ let CreateTypeProvider ( else // No appropriate constructor found - raise (TypeProviderError(FSComp.SR.etProviderDoesNotHaveValidConstructor(), typeProviderImplementationType.FullName, m)) + raise (TypeProviderError(FSComp.SR.etProviderDoesNotHaveValidConstructor(), !! typeProviderImplementationType.FullName, m)) let GetTypeProvidersOfAssembly ( runtimeAssemblyFilename: string, @@ -171,7 +168,7 @@ let GetTypeProvidersOfAssembly ( let designTimeAssemblyName = try if designTimeName.EndsWith(".dll", StringComparison.OrdinalIgnoreCase) then - Some (AssemblyName (Path.GetFileNameWithoutExtension designTimeName)) + Some (AssemblyName (!!Path.GetFileNameWithoutExtension(designTimeName))) else Some (AssemblyName designTimeName) with :? ArgumentException -> @@ -193,7 +190,7 @@ let GetTypeProvidersOfAssembly ( CreateTypeProvider (t, runtimeAssemblyFilename, resolutionEnvironment, isInvalidationSupported, isInteractive, systemRuntimeContainsType, systemRuntimeAssemblyVersion, m) match box resolver with - | Null -> () + | null -> () | _ -> yield (resolver, ilScopeRefOfRuntimeAssembly) | None, _ -> @@ -292,7 +289,7 @@ type ProvidedTypeComparer() = interface IEqualityComparer with member _.GetHashCode(ty: ProvidedType) = hash (key ty) - member _.Equals(ty1: ProvidedType, ty2: ProvidedType) = (key ty1 = key ty2) + member _.Equals(ty1: ProvidedType, ty2: ProvidedType) = nullSafeEquality ty1 ty2 (fun ty1 ty2 -> key ty1 = key ty2) /// The context used to interpret information in the closure of System.Type, System.MethodInfo and other /// info objects coming from the type provider. @@ -355,7 +352,7 @@ type ProvidedType (x: Type, ctxt: ProvidedTypeContext) = let isMeasure = lazy x.CustomAttributes - |> Seq.exists (fun a -> a.Constructor.DeclaringType.FullName = typeof.FullName) + |> Seq.exists (fun a -> (!! a.Constructor.DeclaringType).FullName = typeof.FullName) let provide () = ProvidedCustomAttributeProvider (fun _ -> x.CustomAttributes) :> IProvidedCustomAttributeProvider @@ -423,7 +420,7 @@ type ProvidedType (x: Type, ctxt: ProvidedTypeContext) = member _.GetGenericArguments() = x.GetGenericArguments() |> ProvidedType.CreateArray ctxt - member _.ApplyStaticArguments(provider: ITypeProvider, fullTypePathAfterArguments, staticArgs: obj[]) = + member _.ApplyStaticArguments(provider: ITypeProvider, fullTypePathAfterArguments, staticArgs: objnull[]) = provider.ApplyStaticArguments(x, fullTypePathAfterArguments, staticArgs) |> ProvidedType.Create ctxt member _.IsVoid = (Type.op_Equality(x, typeof) || (x.Namespace = "System" && x.Name = "Void")) @@ -484,9 +481,9 @@ type ProvidedType (x: Type, ctxt: ProvidedTypeContext) = static member CreateNonNull ctxt x = ProvidedType (x, ctxt) - static member CreateWithNullCheck ctxt name x = + static member CreateWithNullCheck ctxt name (x:Type MaybeNull) = match x with - | Null -> nullArg name + | null -> nullArg name | t -> ProvidedType (t, ctxt) static member CreateArray ctxt (xs: Type[] MaybeNull) : ProvidedType[] MaybeNull = @@ -535,7 +532,8 @@ type ProvidedCustomAttributeProvider (attributes :ITypeProvider -> seq] let (|Arg|_|) (x: CustomAttributeTypedArgument) = match x.Value with null -> ValueNone | v -> ValueSome v - let findAttribByName tyFullName (a: CustomAttributeData) = (a.Constructor.DeclaringType.FullName = tyFullName) + let findAttribByName tyFullName (a: CustomAttributeData) = ((!!a.Constructor.DeclaringType).FullName = tyFullName) + let findAttrib (ty: Type) a = findAttribByName ty.FullName a interface IProvidedCustomAttributeProvider with member _.GetAttributeConstructorArgs (provider, attribName) = @@ -545,11 +543,11 @@ type ProvidedCustomAttributeProvider (attributes :ITypeProvider -> seq Seq.toList - |> List.map (function Arg null -> None | Arg obj -> Some obj | _ -> None) + |> List.map (function Arg obj -> Some obj | _ -> None) let namedArgs = a.NamedArguments |> Seq.toList - |> List.map (fun arg -> arg.MemberName, match arg.TypedValue with Arg null -> None | Arg obj -> Some obj | _ -> None) + |> List.map (fun arg -> arg.MemberName, match arg.TypedValue with Arg obj -> Some obj | _ -> None) ctorArgs, namedArgs) member _.GetHasTypeProviderEditorHideMethodsAttribute provider = @@ -608,7 +606,7 @@ type ProvidedMemberInfo (x: MemberInfo, ctxt) = type ProvidedParameterInfo (x: ParameterInfo, ctxt) = let provide () = ProvidedCustomAttributeProvider (fun _ -> x.CustomAttributes) :> IProvidedCustomAttributeProvider - member _.Name = let nm = x.Name in match box nm with null -> "" | _ -> nm + member _.Name = let nm = x.Name in match box nm with null -> "" | _ -> !!nm member _.IsOut = x.IsOut @@ -667,11 +665,11 @@ type ProvidedAssembly (x: Assembly) = member _.GetName() = x.GetName() - member _.FullName = x.FullName + member _.FullName = !!x.FullName member _.GetManifestModuleContents(provider: ITypeProvider) = provider.GetGeneratedAssemblyContents x - static member Create x : ProvidedAssembly MaybeNull = match x with null -> null | t -> ProvidedAssembly (t) + static member Create (x: Assembly MaybeNull) : ProvidedAssembly MaybeNull = match x with null -> null | t -> ProvidedAssembly (t) member _.Handle = x @@ -739,13 +737,13 @@ type ProvidedMethodBase (x: MethodBase, ctxt) = [| typeof |], null) if isNull meth then [| |] else let paramsAsObj = - try meth.Invoke(provider, bindingFlags ||| BindingFlags.InvokeMethod, null, [| box x |], null) + try (!!meth).Invoke(provider, bindingFlags ||| BindingFlags.InvokeMethod, null, [| box x |], null) with err -> raise (StripException (StripException err)) paramsAsObj :?> ParameterInfo[] staticParams |> ProvidedParameterInfo.CreateArrayNonNull ctxt - member _.ApplyStaticArgumentsForMethod(provider: ITypeProvider, fullNameAfterArguments: string, staticArgs: obj[]) = + member _.ApplyStaticArgumentsForMethod(provider: ITypeProvider, fullNameAfterArguments: string, staticArgs: objnull[]) = let bindingFlags = BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.InvokeMethod let mb = @@ -760,8 +758,9 @@ type ProvidedMethodBase (x: MethodBase, ctxt) = [| typeof; typeof; typeof |], null) match meth with - | Null -> failwith (FSComp.SR.estApplyStaticArgumentsForMethodNotImplemented()) - | _ -> + | null -> failwith (FSComp.SR.estApplyStaticArgumentsForMethodNotImplemented()) + | meth -> + let mbAsObj = try meth.Invoke(provider, bindingFlags ||| BindingFlags.InvokeMethod, null, [| box x; box fullNameAfterArguments; box staticArgs |], null) with err -> raise (StripException (StripException err)) @@ -844,6 +843,7 @@ type ProvidedMethodInfo (x: MethodInfo, ctxt) = | Null -> null | NonNull x -> ProvidedMethodInfo (x, ctxt) + static member CreateArray ctxt (xs: MethodInfo[] MaybeNull) : ProvidedMethodInfo[] MaybeNull = match xs with | Null -> null @@ -1096,14 +1096,14 @@ let GetInvokerExpression (provider: ITypeProvider, methodBase: ProvidedMethodBas /// Compute the Name or FullName property of a provided type, reporting appropriate errors let CheckAndComputeProvidedNameProperty(m, st: Tainted, proj, propertyString) = - let name = + let name : string MaybeNull = try st.PUntaint(proj, m) with :? TypeProviderError as tpe -> let newError = tpe.MapText((fun msg -> FSComp.SR.etProvidedTypeWithNameException(propertyString, msg)), st.TypeProviderDesignation, m) raise newError if String.IsNullOrEmpty name then raise (TypeProviderError(FSComp.SR.etProvidedTypeWithNullOrEmptyName propertyString, st.TypeProviderDesignation, m)) - name + !!name /// Verify that this type provider has supported attributes let ValidateAttributesOfProvidedType (m, st: Tainted) = @@ -1191,7 +1191,7 @@ let ValidateProvidedTypeAfterStaticInstantiation(m, st: Tainted, e let miDeclaringTypeFullName = TryMemberMember (miDeclaringType, fullName, memberName, "FullName", m, "invalid declaring type full name", - fun miDeclaringType -> miDeclaringType.FullName) + fun miDeclaringType -> !!miDeclaringType.FullName) |> unmarshal if not (ProvidedType.TaintedEquals (st, miDeclaringType)) then @@ -1345,7 +1345,7 @@ let ComputeMangledNameForApplyStaticParameters(nm, staticArgs, staticParams: Tai PrettyNaming.ComputeMangledNameWithoutDefaultArgValues(nm, staticArgs, defaultArgValues) /// Apply the given provided method to the given static arguments (the arguments are assumed to have been sorted into application order) -let TryApplyProvidedMethod(methBeforeArgs: Tainted, staticArgs: obj[], m: range) = +let TryApplyProvidedMethod(methBeforeArgs: Tainted, staticArgs: objnull[], m: range) = if staticArgs.Length = 0 then Some methBeforeArgs else @@ -1364,7 +1364,7 @@ let TryApplyProvidedMethod(methBeforeArgs: Tainted, staticAr /// Apply the given provided type to the given static arguments (the arguments are assumed to have been sorted into application order -let TryApplyProvidedType(typeBeforeArguments: Tainted, optGeneratedTypePath: string list option, staticArgs: obj[], m: range) = +let TryApplyProvidedType(typeBeforeArguments: Tainted, optGeneratedTypePath: string list option, staticArgs: objnull[], m: range) = if staticArgs.Length = 0 then Some (typeBeforeArguments, (fun () -> ())) else @@ -1427,7 +1427,7 @@ let TryLinkProvidedType(resolver: Tainted, moduleOrNamespace: str sp.PUntaint((fun sp -> let pt = sp.ParameterType let uet = if pt.IsEnum then pt.GetEnumUnderlyingType() else pt - uet.FullName), range) + !!uet.FullName), range) match spReprTypeName with | "System.SByte" -> box (sbyte arg) @@ -1449,8 +1449,8 @@ let TryLinkProvidedType(resolver: Tainted, moduleOrNamespace: str | _ -> if sp.PUntaint ((fun sp -> sp.IsOptional), range) then match sp.PUntaint((fun sp -> sp.RawDefaultValue), range) with - | Null -> error (Error(FSComp.SR.etStaticParameterRequiresAValue (spName, typeBeforeArgumentsName, typeBeforeArgumentsName, spName), range0)) - | NonNull v -> v + | null -> error (Error(FSComp.SR.etStaticParameterRequiresAValue (spName, typeBeforeArgumentsName, typeBeforeArgumentsName, spName), range0)) + | v -> v else error(Error(FSComp.SR.etProvidedTypeReferenceMissingArgument spName, range0))) @@ -1467,7 +1467,7 @@ let GetPartsOfNamespaceRecover(namespaceName: string MaybeNull) = | Null -> [] | NonNull namespaceName -> if namespaceName.Length = 0 then [""] - else splitNamespace (nonNull namespaceName) + else splitNamespace namespaceName /// Get the parts of a .NET namespace. Special rules: null means global, empty is not allowed. let GetProvidedNamespaceAsPath (m, resolver: Tainted, namespaceName:string MaybeNull) = diff --git a/src/Compiler/TypedTree/TypeProviders.fsi b/src/Compiler/TypedTree/TypeProviders.fsi index 112b3a09c1b..c99f2ab3775 100755 --- a/src/Compiler/TypedTree/TypeProviders.fsi +++ b/src/Compiler/TypedTree/TypeProviders.fsi @@ -214,7 +214,7 @@ type ProvidedType = type IProvidedCustomAttributeProvider = abstract GetHasTypeProviderEditorHideMethodsAttribute: provider: ITypeProvider -> bool - abstract GetDefinitionLocationAttribute: provider: ITypeProvider -> (string * int * int) option + abstract GetDefinitionLocationAttribute: provider: ITypeProvider -> (string MaybeNull * int * int) option abstract GetXmlDocAttributes: provider: ITypeProvider -> string[] @@ -313,7 +313,7 @@ type ProvidedParameterInfo = member IsOptional: bool - member RawDefaultValue: obj + member RawDefaultValue: objnull member HasDefaultValue: bool @@ -482,12 +482,12 @@ val ValidateProvidedTypeAfterStaticInstantiation: /// to check the type name is as expected (this function is called by the caller of TryApplyProvidedType /// after other checks are made). val TryApplyProvidedType: - typeBeforeArguments: Tainted * optGeneratedTypePath: string list option * staticArgs: obj[] * range -> + typeBeforeArguments: Tainted * optGeneratedTypePath: string list option * staticArgs: objnull[] * range -> (Tainted * (unit -> unit)) option /// Try to apply a provided method to the given static arguments. val TryApplyProvidedMethod: - methBeforeArgs: Tainted * staticArgs: obj[] * range -> Tainted option + methBeforeArgs: Tainted * staticArgs: objnull[] * range -> Tainted option /// Try to resolve a type in the given extension type resolver val TryResolveProvidedType: Tainted * range * string[] * typeName: string -> Tainted option diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 37edb437867..e6f8faf3b66 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -3392,7 +3392,7 @@ type NonLocalValOrMemberRef = member x.DebugText = x.ToString() /// For debugging - override x.ToString() = x.EnclosingEntity.nlr.ToString() + "::" + x.ItemKey.PartialKey.LogicalName + override x.ToString() = !! x.EnclosingEntity.nlr.ToString() + "::" + x.ItemKey.PartialKey.LogicalName /// Represents the path information for a reference to a value or member in another assembly, disassociated /// from any particular reference. @@ -5112,11 +5112,11 @@ type Expr = override expr.ToString() = expr.ToDebugString(3) - member expr.ToDebugString(depth: int) = + member expr.ToDebugString(depth: int) : string = if depth = 0 then ".." else let depth = depth - 1 match expr with - | Const (c, _, _) -> c.ToString() + | Const (c, _, _) -> string c | Val (v, _, _) -> v.LogicalName | Sequential (e1, e2, _, _) -> "Sequential(" + e1.ToDebugString(depth) + ", " + e2.ToDebugString(depth) + ")" | Lambda (_, _, _, vs, body, _, _) -> sprintf "Lambda(%+A, " vs + body.ToDebugString(depth) + ")" @@ -5695,13 +5695,13 @@ module CcuTypeForwarderTable = if remainingPath.Count = 0 then finalKey else - remainingPath.Array.[remainingPath.Offset] + (!!remainingPath.Array).[remainingPath.Offset] match nodes.TryGetValue searchTerm with | true, innerTree -> if remainingPath.Count = 0 then innerTree.Value else - findInTree (ArraySegment(remainingPath.Array, remainingPath.Offset + 1, remainingPath.Count - 1)) finalKey innerTree + findInTree (ArraySegment((!!remainingPath.Array), remainingPath.Offset + 1, remainingPath.Count - 1)) finalKey innerTree | false, _ -> None /// Represents a table of .NET CLI type forwarders for an assembly @@ -6011,7 +6011,7 @@ type Construct() = let lazyBaseTy = LazyWithContext.Create ((fun (m, objTy) -> - let baseSystemTy = st.PApplyOption((fun st -> match st.BaseType with null -> None | ty -> Some (nonNull ty)), m) + let baseSystemTy = st.PApplyOption((fun st -> match st.BaseType with null -> None | ty -> Some (ty)), m) match baseSystemTy with | None -> objTy | Some t -> importProvidedType t), @@ -6334,5 +6334,5 @@ type Construct() = // Coordinates from type provider are 1-based for lines and columns // Coordinates internally in the F# compiler are 1-based for lines and 0-based for columns let pos = Position.mkPos line (max 0 (column - 1)) - mkRange filePath pos pos |> Some + mkRange !!filePath pos pos |> Some #endif diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index 2abe8ed08f7..56d2866ac4a 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -3139,7 +3139,7 @@ type TType = /// For now, used only as a discriminant in error message. /// See https://github.com/dotnet/fsharp/issues/2561 - member GetAssemblyName: unit -> string + member GetAssemblyName: unit -> string MaybeNull override ToString: unit -> string diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index be78209034e..9eda4a9c2de 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -38,6 +38,19 @@ let AccFreeVarsStackGuardDepth = GetEnvInteger "FSHARP_AccFreeVars" 100 let RemapExprStackGuardDepth = GetEnvInteger "FSHARP_RemapExpr" 50 let FoldExprStackGuardDepth = GetEnvInteger "FSHARP_FoldExpr" 50 +let inline compareBy (x: 'T MaybeNull) (y: 'T MaybeNull) ([]func: 'T -> 'K) = +#if NO_CHECKNULLS + compare (func x) (func y) +#else + match x,y with + | null,null -> 0 + | null,_ -> -1 + | _,null -> 1 + | x,y -> compare (func !!x) (func !!y) +#endif + + + //--------------------------------------------------------------------------- // Basic data structures //--------------------------------------------------------------------------- @@ -1187,9 +1200,9 @@ let rec getErasedTypes g ty checkForNullness = // Standard orderings, e.g. for order set/map keys //--------------------------------------------------------------------------- -let valOrder = { new IComparer with member _.Compare(v1, v2) = compare v1.Stamp v2.Stamp } +let valOrder = { new IComparer with member _.Compare(v1, v2) = compareBy v1 v2 _.Stamp } -let tyconOrder = { new IComparer with member _.Compare(tycon1, tycon2) = compare tycon1.Stamp tycon2.Stamp } +let tyconOrder = { new IComparer with member _.Compare(tycon1, tycon2) = compareBy tycon1 tycon2 _.Stamp } let recdFieldRefOrder = { new IComparer with @@ -2168,7 +2181,7 @@ let unionFreeTycons s1 s2 = let typarOrder = { new IComparer with - member x.Compare (v1: Typar, v2: Typar) = compare v1.Stamp v2.Stamp } + member x.Compare (v1: Typar, v2: Typar) = compareBy v1 v2 _.Stamp } let emptyFreeTypars = Zset.empty typarOrder let unionFreeTypars s1 s2 = @@ -3230,7 +3243,7 @@ type DisplayEnv = ControlPath (splitNamespace ExtraTopLevelOperatorsName) ] -let (+.+) s1 s2 = if String.IsNullOrEmpty(s1) then s2 else s1+"."+s2 +let (+.+) s1 s2 = if String.IsNullOrEmpty(s1) then s2 else !!s1+"."+s2 let layoutOfPath p = sepListL SepL.dot (List.map (tagNamespace >> wordL) p) @@ -6236,7 +6249,7 @@ and remapTyconRepr ctxt tmenv repr = // This is actually done on-demand (see the implementation of ProvidedTypeContext) ProvidedType = info.ProvidedType.PApplyNoFailure (fun st -> - let ctxt = st.Context.RemapTyconRefs(unbox >> remapTyconRef tmenv.tyconRefRemap >> box) + let ctxt = st.Context.RemapTyconRefs(unbox >> remapTyconRef tmenv.tyconRefRemap >> box >> (!!)) ProvidedType.ApplyContext (st, ctxt)) } #endif | TNoRepr -> repr @@ -8210,7 +8223,7 @@ let mkCompilationMappingAttrForQuotationResource (g: TcGlobals) (nm, tys: ILType #if !NO_TYPEPROVIDERS let isTypeProviderAssemblyAttr (cattr: ILAttribute) = - cattr.Method.DeclaringType.BasicQualifiedName = typeof.FullName + cattr.Method.DeclaringType.BasicQualifiedName = !! typeof.FullName let TryDecodeTypeProviderAssemblyAttr (cattr: ILAttribute) : string MaybeNull option = if isTypeProviderAssemblyAttr cattr then @@ -8985,7 +8998,7 @@ let buildAccessPath (cp: CompilationPath option) = System.String.Join(".", ap) | None -> "Extension Type" -let prependPath path name = if String.IsNullOrEmpty(path) then name else path + "." + name +let prependPath path name = if String.IsNullOrEmpty(path) then name else !!path + "." + name let XmlDocSigOfVal g full path (v: Val) = let parentTypars, methTypars, cxs, argInfos, retTy, prefix, path, name = @@ -11302,7 +11315,7 @@ type TraitWitnessInfoHashMap<'T> = ImmutableDictionary let EmptyTraitWitnessInfoHashMap g : TraitWitnessInfoHashMap<'T> = ImmutableDictionary.Create( { new IEqualityComparer<_> with - member _.Equals(a, b) = traitKeysAEquiv g TypeEquivEnv.Empty a b + member _.Equals(a, b) = nullSafeEquality a b (fun a b -> traitKeysAEquiv g TypeEquivEnv.Empty a b) member _.GetHashCode(a) = hash a.MemberName }) diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index 6093f9cd391..ad5bb233361 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -67,7 +67,11 @@ type PickledDataWithReferences<'rawData> = //--------------------------------------------------------------------------- [] +#if NO_CHECKNULLS type Table<'T> = +#else +type Table<'T when 'T: not null> = +#endif { name: string tbl: Dictionary<'T, int> mutable rows: ResizeArray<'T> diff --git a/src/Compiler/TypedTree/tainted.fs b/src/Compiler/TypedTree/tainted.fs index 7b27c4745f4..d23b5183a53 100644 --- a/src/Compiler/TypedTree/tainted.fs +++ b/src/Compiler/TypedTree/tainted.fs @@ -89,7 +89,7 @@ type internal Tainted<'T> (context: TaintedContext, value: 'T) = | _ -> () member _.TypeProviderDesignation = - context.TypeProvider.GetType().FullName + !! context.TypeProvider.GetType().FullName member _.TypeProviderAssemblyRef = context.TypeProviderAssemblyRef diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index 180f9c4c4e3..b6fafe1c1b9 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -6,6 +6,8 @@ open System open System.Diagnostics open System.IO open System.Text +open Internal.Utilities.Library + module ActivityNames = [] @@ -137,16 +139,17 @@ module internal Activity = ActivityStarted = (fun a -> a.AddTag(gcStatsInnerTag, collectGCStats ()) |> ignore), ActivityStopped = (fun a -> - let statsBefore = a.GetTagItem(gcStatsInnerTag) :?> GCStats let statsAfter = collectGCStats () let p = Process.GetCurrentProcess() a.AddTag(Tags.workingSetMB, p.WorkingSet64 / 1_000_000L) |> ignore a.AddTag(Tags.handles, p.HandleCount) |> ignore a.AddTag(Tags.threads, p.Threads.Count) |> ignore - for i = 0 to statsAfter.Length - 1 do - a.AddTag($"gc{i}", statsAfter[i] - statsBefore[i]) |> ignore) - + match a.GetTagItem(gcStatsInnerTag) with + | :? GCStats as statsBefore -> + for i = 0 to statsAfter.Length - 1 do + a.AddTag($"gc{i}", statsAfter[i] - statsBefore[i]) |> ignore + | _ -> ()) ) ActivitySource.AddActivityListener(l) @@ -197,11 +200,11 @@ module internal Activity = module CsvExport = - let private escapeStringForCsv (o: obj) = - if isNull o then - "" - else - let mutable txtVal = o.ToString() + let private escapeStringForCsv (o: obj MaybeNull) = + match o with + | null -> "" + | o -> + let mutable txtVal = match o.ToString() with | null -> "" | s -> s let hasComma = txtVal.IndexOf(',') > -1 let hasQuote = txtVal.IndexOf('"') > -1 @@ -216,7 +219,7 @@ module internal Activity = let private createCsvRow (a: Activity) = let sb = new StringBuilder(128) - let appendWithLeadingComma (s: string) = + let appendWithLeadingComma (s: string MaybeNull) = sb.Append(',') |> ignore sb.Append(s) |> ignore @@ -234,7 +237,7 @@ module internal Activity = sb.ToString() - let addCsvFileListener pathToFile = + let addCsvFileListener (pathToFile:string) = if pathToFile |> File.Exists |> not then File.WriteAllLines( pathToFile, @@ -256,7 +259,7 @@ module internal Activity = let l = new ActivityListener( - ShouldListenTo = (fun a -> ActivityNames.AllRelevantNames |> Array.contains a.Name), + ShouldListenTo = (fun a ->ActivityNames.AllRelevantNames |> Array.contains a.Name), Sample = (fun _ -> ActivitySamplingResult.AllData), ActivityStopped = (fun a -> msgQueue.Post(createCsvRow a)) ) diff --git a/src/Compiler/Utilities/FileSystem.fs b/src/Compiler/Utilities/FileSystem.fs index c2f4636ce8a..378d3eb149e 100644 --- a/src/Compiler/Utilities/FileSystem.fs +++ b/src/Compiler/Utilities/FileSystem.fs @@ -427,7 +427,7 @@ module internal FileSystemUtils = if not (hasExtensionWithValidate false path) then raise (ArgumentException("chopExtension")) // message has to be precisely this, for OCaml compatibility, and no argument name can be set - Path.Combine(Path.GetDirectoryName path, Path.GetFileNameWithoutExtension(path)) + Path.Combine(!! Path.GetDirectoryName(path), !! Path.GetFileNameWithoutExtension(path)) let fileNameOfPath path = checkPathForIllegalChars path @@ -694,15 +694,19 @@ type DefaultFileSystem() as this = default _.IsStableFileHeuristic(fileName: string) = let directory = Path.GetDirectoryName fileName - directory.Contains("Reference Assemblies/") - || directory.Contains("Reference Assemblies\\") - || directory.Contains("packages/") - || directory.Contains("packages\\") - || directory.Contains("lib/mono/") + match directory with + | Null -> false + | NonNull directory -> + directory.Contains("Reference Assemblies/") + || directory.Contains("Reference Assemblies\\") + || directory.Contains("packages/") + || directory.Contains("packages\\") + || directory.Contains("lib/mono/") abstract ChangeExtensionShim: path: string * extension: string -> string - default _.ChangeExtensionShim(path: string, extension: string) : string = Path.ChangeExtension(path, extension) + default _.ChangeExtensionShim(path: string, extension: string) : string = + !! Path.ChangeExtension(path, extension) interface IFileSystem with member _.AssemblyLoader = this.AssemblyLoader @@ -820,7 +824,7 @@ module public StreamExtensions = use sr = new StreamReader(s, encoding, true) while not <| sr.EndOfStream do - yield sr.ReadLine() + yield !! sr.ReadLine() } member s.ReadAllLines(?encoding: Encoding) : string array = diff --git a/src/Compiler/Utilities/HashMultiMap.fs b/src/Compiler/Utilities/HashMultiMap.fs index b88af5d77eb..3403aae4e84 100644 --- a/src/Compiler/Utilities/HashMultiMap.fs +++ b/src/Compiler/Utilities/HashMultiMap.fs @@ -7,7 +7,11 @@ open System.Collections.Generic // Each entry in the HashMultiMap dictionary has at least one entry. Under normal usage each entry has _only_ // one entry. So use two hash tables: one for the main entries and one for the overflow. [] -type internal HashMultiMap<'Key, 'Value>(size: int, comparer: IEqualityComparer<'Key>) = +type internal HashMultiMap<'Key, 'Value +#if !NO_CHECKNULLS + when 'Key:not null +#endif + >(size: int, comparer: IEqualityComparer<'Key>) = let firstEntries = Dictionary<_, _>(size, comparer) diff --git a/src/Compiler/Utilities/HashMultiMap.fsi b/src/Compiler/Utilities/HashMultiMap.fsi index a4dd51a5bba..60fa9dce9c4 100644 --- a/src/Compiler/Utilities/HashMultiMap.fsi +++ b/src/Compiler/Utilities/HashMultiMap.fsi @@ -7,7 +7,11 @@ open System.Collections.Generic /// Hash tables, by default based on F# structural "hash" and (=) functions. /// The table may map a single key to multiple bindings. [] -type internal HashMultiMap<'Key, 'Value> = +type internal HashMultiMap<'Key, 'Value +#if !NO_CHECKNULLS + when 'Key:not null +#endif + > = /// Create a new empty mutable HashMultiMap with the given key hash/equality functions. new: comparer: IEqualityComparer<'Key> -> HashMultiMap<'Key, 'Value> diff --git a/src/Compiler/Utilities/LruCache.fs b/src/Compiler/Utilities/LruCache.fs index 62abc1d829c..92f73885eb7 100644 --- a/src/Compiler/Utilities/LruCache.fs +++ b/src/Compiler/Utilities/LruCache.fs @@ -6,6 +6,7 @@ open System open System.Collections.Generic open System.Diagnostics +open Internal.Utilities.Library open Internal.Utilities.Library.Extras [] @@ -22,7 +23,12 @@ type internal ValueLink<'T when 'T: not struct> = | Weak of WeakReference<'T> [] -type internal LruCache<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'TVersion: equality and 'TValue: not struct> +type internal LruCache<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'TVersion: equality and 'TValue: not struct +#if !NO_CHECKNULLS + and 'TKey:not null + and 'TVersion:not null +#endif + > (keepStrongly, ?keepWeakly, ?requiredToKeep, ?event) = let keepWeakly = defaultArg keepWeakly 100 @@ -35,8 +41,10 @@ type internal LruCache<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'TVers let strongList = LinkedList<'TKey * 'TVersion * string * ValueLink<'TValue>>() let weakList = LinkedList<'TKey * 'TVersion * string * ValueLink<'TValue>>() - let rec removeCollected (node: LinkedListNode<_>) = - if node <> null then + let rec removeCollected (possiblyNullNode: LinkedListNode<_> MaybeNull) = + match possiblyNullNode with + | null -> () + | node -> let key, version, label, value = node.Value match value with @@ -64,9 +72,10 @@ type internal LruCache<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'TVers let mutable node = weakList.Last while weakList.Count > keepWeakly && node <> null do - let previous = node.Previous - let key, version, label, _ = node.Value - weakList.Remove node + let notNullNode = !! node + let previous = notNullNode.Previous + let key, version, label, _ = notNullNode.Value + weakList.Remove notNullNode dictionary[key].Remove version |> ignore if dictionary[key].Count = 0 then @@ -81,14 +90,15 @@ type internal LruCache<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'TVers let mutable anythingWeakened = false while strongList.Count > keepStrongly && node <> null do - let previous = node.Previous + let notNullNode = !! node + let previous = notNullNode.Previous - match node.Value with + match notNullNode.Value with | _, _, _, Strong v when requiredToKeep v -> () | key, version, label, Strong v -> - strongList.Remove node - node.Value <- key, version, label, Weak(WeakReference<_> v) - weakList.AddFirst node + strongList.Remove notNullNode + notNullNode.Value <- key, version, label, Weak(WeakReference<_> v) + weakList.AddFirst notNullNode event CacheEvent.Weakened (label, key, version) anythingWeakened <- true | _key, _version, _label, _ -> failwith "Invalid state, weak reference in strong list" diff --git a/src/Compiler/Utilities/LruCache.fsi b/src/Compiler/Utilities/LruCache.fsi index d4d4d5ea83f..5979304f163 100644 --- a/src/Compiler/Utilities/LruCache.fsi +++ b/src/Compiler/Utilities/LruCache.fsi @@ -12,7 +12,12 @@ type internal CacheEvent = /// /// It's also versioned, meaning each key can have multiple versions and only the latest one is kept strongly. /// Older versions are kept weakly and can be collected by GC. -type internal LruCache<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'TVersion: equality and 'TValue: not struct> = +type internal LruCache<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'TVersion: equality and 'TValue: not struct +#if !NO_CHECKNULLS + and 'TKey:not null + and 'TVersion:not null +#endif + > = /// Maximum number of strongly held results to keep in the cache /// Maximum number of weakly held results to keep in the cache diff --git a/src/Compiler/Utilities/NullnessShims.fs b/src/Compiler/Utilities/NullnessShims.fs new file mode 100644 index 00000000000..785a6c6a3b8 --- /dev/null +++ b/src/Compiler/Utilities/NullnessShims.fs @@ -0,0 +1,72 @@ +namespace Internal.Utilities.Library + +open System + +[] +module internal NullnessShims = + + let inline isNotNull (x: 'T) = not (isNull x) + +#if NO_CHECKNULLS || BUILDING_WITH_LKG + type 'T MaybeNull when 'T: not struct = 'T + type objnull = obj + + let inline (^) (a: 'a) ([] b: 'a -> 'b) : 'b = + match a with + | null -> Unchecked.defaultof<'b> + | _ -> b a + + let inline (|NonNullQuick|) (x: 'T MaybeNull) = + match x with + | null -> raise (NullReferenceException()) + | v -> v + + let inline nonNull<'T when 'T:not struct and 'T:null> (x: 'T MaybeNull ) = + match x with + | null -> raise (NullReferenceException()) + | v -> v + + let inline (|Null|NonNull|) (x: 'T MaybeNull) : Choice = + match x with + | null -> Null + | v -> NonNull v + + let inline nullArgCheck paramName (x: 'T MaybeNull) = + if isNull (box x) then raise (ArgumentNullException(paramName)) + else x + + let inline (!!) x = x + + let inline defaultIfNull defaultValue arg = match arg with | null -> defaultValue | _ -> arg + + let inline nullSafeEquality (x: MaybeNull<'T>) (y: MaybeNull<'T>) ([]nonNullEqualityFunc:'T->'T->bool) = + match box x, box y with + | null, null -> true + | null,_ | _, null -> false + | _,_ -> nonNullEqualityFunc x y +#else + type 'T MaybeNull when 'T: not null and 'T: not struct = 'T | null + + let inline (^) (a: 'a | null) ([] b: 'a -> 'b) : ('b | null) = + match a with + | Null -> null + | NonNull v -> b v + + let inline (!!) (x:'T | null) = Unchecked.nonNull x + + let inline nullSafeEquality (x: MaybeNull<'T>) (y: MaybeNull<'T>) ([]nonNullEqualityFunc:'T->'T->bool) = + match x, y with + | null, null -> true + | null,_ | _, null -> false + | x, y -> nonNullEqualityFunc !!x !!y + +#endif + + + + [] + let inline (|NonEmptyString|_|) (x: string MaybeNull) = + match x with + | null -> ValueNone + | "" -> ValueNone + | v -> ValueSome v \ No newline at end of file diff --git a/src/Compiler/Utilities/TaggedCollections.fs b/src/Compiler/Utilities/TaggedCollections.fs index 814a7afbc0a..4676c2673a0 100644 --- a/src/Compiler/Utilities/TaggedCollections.fs +++ b/src/Compiler/Utilities/TaggedCollections.fs @@ -9,6 +9,7 @@ namespace Internal.Utilities.Collections.Tagged open Microsoft.FSharp.Core open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open System.Collections.Generic +open Internal.Utilities.Library [] [] @@ -141,7 +142,7 @@ module SetTree = | _ -> add comparer k (add comparer t2.Key t1) | _ -> add comparer k (add comparer t1.Key t2) - let rec split (comparer: IComparer<'T>) pivot (t: SetTree<'T>) = + let rec split (comparer: IComparer<'T>) (pivot: 'T) (t: SetTree<'T>) = // Given a pivot and a set t // Return { x in t s.t. x < pivot }, pivot in t?, { x in t s.t. x > pivot } if isEmpty t then @@ -178,7 +179,7 @@ module SetTree = let k3, l' = spliceOutSuccessor tn.Left in k3, mk l' tn.Key tn.Right | _ -> t.Key, empty - let rec remove (comparer: IComparer<'T>) k (t: SetTree<'T>) = + let rec remove (comparer: IComparer<'T>) (k: 'T) (t: SetTree<'T>) = if isEmpty t then t else @@ -200,7 +201,7 @@ module SetTree = rebalance tn.Left tn.Key (remove comparer k tn.Right) | _ -> if c = 0 then empty else t - let rec contains (comparer: IComparer<'T>) k (t: SetTree<'T>) = + let rec contains (comparer: IComparer<'T>) (k: 'T) (t: SetTree<'T>) = if isEmpty t then false else @@ -809,7 +810,7 @@ module MapTree = let indexNotFound () = raise (KeyNotFoundException("An index satisfying the predicate was not found in the collection")) - let rec tryGetValue (comparer: IComparer<'Key>) k (v: byref<'Value>) (m: MapTree<'Key, 'Value>) = + let rec tryGetValue (comparer: IComparer<'Key>) (k: 'Key) (v: byref<'Value>) (m: MapTree<'Key, 'Value>) = if isEmpty m then false else @@ -823,7 +824,7 @@ module MapTree = | :? MapTreeNode<'Key, 'Value> as mn -> tryGetValue comparer k &v (if c < 0 then mn.Left else mn.Right) | _ -> false - let find (comparer: IComparer<'Key>) k (m: MapTree<'Key, 'Value>) = + let find (comparer: IComparer<'Key>) (k: 'Key) (m: MapTree<'Key, 'Value>) = let mutable v = Unchecked.defaultof<'Value> if tryGetValue comparer k &v m then v else indexNotFound () diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index aa1fffaf826..b400cc145c5 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -17,7 +17,8 @@ type InterruptibleLazy<'T> private (value, valueFactory: unit -> 'T) = [] // TODO nullness - this is boxed to obj because of an attribute targets bug fixed in main, but not yet shipped (needs shipped 8.0.400) - let mutable valueFactory : obj = valueFactory + let mutable valueFactory : objnull = valueFactory + let mutable value = value @@ -86,35 +87,6 @@ module internal PervasiveAutoOpens = | [ _ ] -> true | _ -> false - let inline isNotNull (x: 'T) = not (isNull x) - -#if NO_CHECKNULLS - type 'T MaybeNull when 'T: null and 'T: not struct = 'T - - let inline (|NonNullQuick|) (x: 'T MaybeNull) = - match x with - | null -> raise (NullReferenceException()) - | v -> v - - let inline nonNull (x: 'T MaybeNull) = - match x with - | null -> raise (NullReferenceException()) - | v -> v - - let inline (|Null|NonNull|) (x: 'T MaybeNull) : Choice = - match x with - | null -> Null - | v -> NonNull v - - let inline nullArgCheck paramName (x: 'T MaybeNull) = - match x with - | null -> raise (ArgumentNullException(paramName)) - | v -> v -#else - type 'T MaybeNull when 'T: not null and 'T: not struct = 'T | null - -#endif - let inline (===) x y = LanguagePrimitives.PhysicalEquality x y /// Per the docs the threshold for the Large Object Heap is 85000 bytes: https://learn.microsoft.com/dotnet/standard/garbage-collection/large-object-heap#how-an-object-ends-up-on-the-large-object-heap-and-how-gc-handles-them @@ -132,7 +104,7 @@ module internal PervasiveAutoOpens = member inline x.EndsWithOrdinalIgnoreCase value = x.EndsWith(value, StringComparison.OrdinalIgnoreCase) - member inline x.IndexOfOrdinal value = + member inline x.IndexOfOrdinal (value:string) = x.IndexOf(value, StringComparison.Ordinal) member inline x.IndexOfOrdinal(value, startIndex) = @@ -182,8 +154,8 @@ module internal PervasiveAutoOpens = type DelayInitArrayMap<'T, 'TDictKey, 'TDictValue>(f: unit -> 'T[]) = let syncObj = obj () - let mutable arrayStore = null - let mutable dictStore = null + let mutable arrayStore : _ array MaybeNull = null + let mutable dictStore : _ MaybeNull = null let mutable func = f @@ -197,11 +169,11 @@ type DelayInitArrayMap<'T, 'TDictKey, 'TDictValue>(f: unit -> 'T[]) = match arrayStore with | NonNull value -> value | _ -> - - arrayStore <- func () + let freshArray = func () + arrayStore <- freshArray func <- Unchecked.defaultof<_> - arrayStore + freshArray finally Monitor.Exit(syncObj) @@ -216,9 +188,9 @@ type DelayInitArrayMap<'T, 'TDictKey, 'TDictValue>(f: unit -> 'T[]) = match dictStore with | NonNull value -> value | _ -> - - dictStore <- this.CreateDictionary(array) - dictStore + let dict = this.CreateDictionary(array) + dictStore <- dict + dict finally Monitor.Exit(syncObj) @@ -231,7 +203,7 @@ type DelayInitArrayMap<'T, 'TDictKey, 'TDictValue>(f: unit -> 'T[]) = module Order = let orderBy (p: 'T -> 'U) = { new IComparer<'T> with - member _.Compare(x, xx) = compare (p x) (p xx) + member _.Compare(x, xx) = compare (p !!x) (p !!xx) } let orderOn p (pxOrder: IComparer<'U>) = @@ -270,6 +242,7 @@ module Array = let order (eltOrder: IComparer<'T>) = { new IComparer<'T array> with member _.Compare(xs, ys) = + let xs,ys = nullArgCheck "xs" xs, nullArgCheck "ys" ys let c = compare xs.Length ys.Length if c <> 0 then @@ -566,6 +539,7 @@ module List = let order (eltOrder: IComparer<'T>) = { new IComparer<'T list> with member _.Compare(xs, ys) = + let xs,ys = nullArgCheck "xs" xs, nullArgCheck "ys" ys let rec loop xs ys = match xs, ys with | [], [] -> 0 @@ -831,13 +805,16 @@ module String = let (|StartsWith|_|) pattern value = if String.IsNullOrWhiteSpace value then None - elif value.StartsWithOrdinal pattern then Some() + elif (!!value).StartsWithOrdinal pattern then Some() else None - let (|Contains|_|) pattern value = - if String.IsNullOrWhiteSpace value then None - elif value.Contains pattern then Some() - else None + let (|Contains|_|) (pattern:string) value = + match value with + | value when String.IsNullOrWhiteSpace value -> None + | null -> None + | value -> + if value.Contains pattern then Some() + else None let getLines (str: string) = use reader = new StringReader(str) @@ -976,7 +953,11 @@ module ResultOrException = | Exception _err -> f () /// Generates unique stamps -type UniqueStampGenerator<'T when 'T: equality>() = +type UniqueStampGenerator<'T when 'T: equality +#if !NO_CHECKNULLS + and 'T:not null +#endif + >() = let encodeTable = ConcurrentDictionary<'T, Lazy>(HashIdentity.Structural) let mutable nItems = -1 @@ -988,7 +969,11 @@ type UniqueStampGenerator<'T when 'T: equality>() = member _.Table = encodeTable.Keys /// memoize tables (all entries cached, never collected) -type MemoizationTable<'T, 'U>(compute: 'T -> 'U, keyComparer: IEqualityComparer<'T>, ?canMemoize) = +type MemoizationTable<'T, 'U +#if !NO_CHECKNULLS + when 'T:not null +#endif + >(compute: 'T -> 'U, keyComparer: IEqualityComparer<'T>, ?canMemoize) = let table = new ConcurrentDictionary<'T, Lazy<'U>>(keyComparer) let computeFunc = Func<_, _>(fun key -> lazy (compute key)) @@ -1004,7 +989,11 @@ type MemoizationTable<'T, 'U>(compute: 'T -> 'U, keyComparer: IEqualityComparer< compute x /// A thread-safe lookup table which is assigning an auto-increment stamp with each insert -type internal StampedDictionary<'T, 'U>(keyComparer: IEqualityComparer<'T>) = +type internal StampedDictionary<'T, 'U +#if !NO_CHECKNULLS + when 'T:not null +#endif + >(keyComparer: IEqualityComparer<'T>) = let table = new ConcurrentDictionary<'T, Lazy>(keyComparer) let mutable count = -1 @@ -1046,7 +1035,7 @@ type LazyWithContext<'T, 'Ctxt> = /// This field holds either the function to run or a LazyWithContextFailure object recording the exception raised /// from running the function. It is null if the thunk has been evaluated successfully. - mutable funcOrException: obj + mutable funcOrException: objnull /// A helper to ensure we rethrow the "original" exception findOriginalException: exn -> exn @@ -1133,7 +1122,7 @@ module IPartialEqualityComparer = let On f (c: IPartialEqualityComparer<_>) = { new IPartialEqualityComparer<_> with member _.InEqualityRelation x = c.InEqualityRelation(f x) - member _.Equals(x, y) = c.Equals(f x, f y) + member _.Equals(x, y) = c.Equals(f !!x, f !!y) member _.GetHashCode x = c.GetHashCode(f x) } diff --git a/src/Compiler/Utilities/illib.fsi b/src/Compiler/Utilities/illib.fsi index 2df0d9c0959..be4edea38f9 100644 --- a/src/Compiler/Utilities/illib.fsi +++ b/src/Compiler/Utilities/illib.fsi @@ -41,31 +41,6 @@ module internal PervasiveAutoOpens = /// Returns true if the list contains exactly 1 element. Otherwise false. val inline isSingleton: l: 'a list -> bool - /// Returns true if the argument is non-null. - val inline isNotNull: x: 'T -> bool when 'T: null - -#if NO_CHECKNULLS - /// Indicates that a type may be null. 'MaybeNull' is used internally in the F# compiler as - /// replacement for 'string?' to align with FS-1060. - type 'T MaybeNull when 'T: null and 'T: not struct = 'T - - /// Asserts the argument is non-null and raises an exception if it is - val inline (|NonNullQuick|): 'T MaybeNull -> 'T - - /// Match on the nullness of an argument. - val inline (|Null|NonNull|): 'T MaybeNull -> Choice - - /// Asserts the argument is non-null and raises an exception if it is - val inline nonNull: x: 'T MaybeNull -> 'T - - /// Checks the argument is non-null - val inline nullArgCheck: paramName: string -> x: 'T MaybeNull -> 'T -#else - /// Indicates that a type may be null. 'MaybeNull' used internally in the F# compiler as unchecked - /// replacement for 'string?' - type 'T MaybeNull when 'T: not null and 'T: not struct = 'T | null -#endif - val inline (===): x: 'a -> y: 'a -> bool when 'a: not struct /// Per the docs the threshold for the Large Object Heap is 85000 bytes: https://learn.microsoft.com/dotnet/standard/garbage-collection/large-object-heap#how-an-object-ends-up-on-the-large-object-heap-and-how-gc-handles-them @@ -111,7 +86,12 @@ type DelayInitArrayMap<'T, 'TDictKey, 'TDictValue> = module internal Order = - val orderBy: p: ('T -> 'U) -> IComparer<'T> when 'U: comparison + val orderBy: p: ('T -> 'U) -> IComparer<'T> + when 'U: comparison +#if !NO_CHECKNULLS + and 'T:not null + and 'T:not struct +#endif val orderOn: p: ('T -> 'U) -> pxOrder: IComparer<'U> -> IComparer<'T> @@ -403,7 +383,11 @@ module internal ResultOrException = val otherwise: f: (unit -> ResultOrException<'a>) -> x: ResultOrException<'a> -> ResultOrException<'a> /// Generates unique stamps -type internal UniqueStampGenerator<'T when 'T: equality> = +type internal UniqueStampGenerator<'T when 'T: equality +#if !NO_CHECKNULLS + and 'T:not null +#endif + > = new: unit -> UniqueStampGenerator<'T> @@ -412,7 +396,11 @@ type internal UniqueStampGenerator<'T when 'T: equality> = member Table: ICollection<'T> /// Memoize tables (all entries cached, never collected unless whole table is collected) -type internal MemoizationTable<'T, 'U> = +type internal MemoizationTable<'T, 'U +#if !NO_CHECKNULLS + when 'T:not null +#endif + > = new: compute: ('T -> 'U) * keyComparer: IEqualityComparer<'T> * ?canMemoize: ('T -> bool) -> MemoizationTable<'T, 'U> @@ -420,7 +408,11 @@ type internal MemoizationTable<'T, 'U> = member Apply: x: 'T -> 'U /// A thread-safe lookup table which is assigning an auto-increment stamp with each insert -type internal StampedDictionary<'T, 'U> = +type internal StampedDictionary<'T, 'U +#if !NO_CHECKNULLS + when 'T:not null +#endif + > = new: keyComparer: IEqualityComparer<'T> -> StampedDictionary<'T, 'U> @@ -453,7 +445,11 @@ type internal LazyWithContext<'T, 'ctxt> = /// Intern tables to save space. module internal Tables = - val memoize: f: ('a -> 'b) -> ('a -> 'b) when 'a: equality + val memoize: f: ('a -> 'b) -> ('a -> 'b) + when 'a: equality +#if !NO_CHECKNULLS && NET8_0_OR_GREATER + and 'a:not null +#endif /// Interface that defines methods for comparing objects using partial equality relation type internal IPartialEqualityComparer<'T> = @@ -463,6 +459,10 @@ type internal IPartialEqualityComparer<'T> = /// Interface that defines methods for comparing objects using partial equality relation module internal IPartialEqualityComparer = val On: f: ('a -> 'b) -> c: IPartialEqualityComparer<'b> -> IPartialEqualityComparer<'a> +#if !NO_CHECKNULLS + when 'a:not null + and 'a:not struct +#endif /// Like Seq.distinctBy but only filters out duplicates for some of the elements val partialDistinctBy: per: IPartialEqualityComparer<'T> -> seq: 'T list -> 'T list diff --git a/src/Compiler/Utilities/sformat.fs b/src/Compiler/Utilities/sformat.fs index 55963dbb034..48ff8fb4029 100644 --- a/src/Compiler/Utilities/sformat.fs +++ b/src/Compiler/Utilities/sformat.fs @@ -7,9 +7,6 @@ // The one implementation file is used because we keep the implementations of // structured formatting the same for fsi.exe and '%A' printing. However F# Interactive has // a richer feature set. - -#nowarn "52" // The value has been copied to ensure the original is not mutated by this operation - #if COMPILER namespace FSharp.Compiler.Text #else @@ -17,6 +14,12 @@ namespace FSharp.Compiler.Text namespace Microsoft.FSharp.Text.StructuredPrintfImpl #endif +#nowarn "52" // The value has been copied to ensure the original is not mutated by this operation +// 3261 and 3262 Nullness warnings - this waits for LKG update, since this file is included in fsharp.core and fsharp.compiler.service and goes via proto build. +// Supporting all possible combinations of available library+compiler versions would complicate code in this source files too much at the moment. +#nowarn "3261" +#nowarn "3262" + // Breakable block layout implementation. // This is a fresh implementation of pre-existing ideas. @@ -29,6 +32,9 @@ open Microsoft.FSharp.Core open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Reflection open Microsoft.FSharp.Collections +#if COMPILER +open Internal.Utilities.Library +#endif [] type TextTag = @@ -417,7 +423,7 @@ type FormatOptions = FloatingPointFormat: string AttributeProcessor: string -> (string * string) list -> bool -> unit #if COMPILER // This is the PrintIntercepts extensibility point currently revealed by fsi.exe's AddPrinter - PrintIntercepts: (IEnvironment -> obj -> Layout option) list + PrintIntercepts: (IEnvironment -> objnull -> Layout option) list StringLimit: int #endif FormatProvider: IFormatProvider @@ -1592,7 +1598,7 @@ module Display = match text with | null -> "" - | _ -> text + | text -> text with e -> // If a .ToString() call throws an exception, catch it and use the message as the result. // This may be informative, e.g. division by zero etc... diff --git a/src/Compiler/Utilities/sformat.fsi b/src/Compiler/Utilities/sformat.fsi index f2ca573d9c4..060f5364503 100644 --- a/src/Compiler/Utilities/sformat.fsi +++ b/src/Compiler/Utilities/sformat.fsi @@ -22,8 +22,8 @@ open System open System.IO open Microsoft.FSharp.Core open Microsoft.FSharp.Collections - #if COMPILER +open Internal.Utilities.Library /// Data representing joints in structured layouts of terms. The representation /// of this data type is only for the consumption of formatting engines. @@ -366,7 +366,7 @@ type internal FormatOptions = { FloatingPointFormat: string AttributeProcessor: string -> (string * string) list -> bool -> unit #if COMPILER // FSharp.Core.dll: PrintIntercepts aren't used there - PrintIntercepts: (IEnvironment -> obj -> Layout option) list + PrintIntercepts: (IEnvironment -> objnull -> Layout option) list StringLimit: int #endif FormatProvider: IFormatProvider diff --git a/src/Compiler/Utilities/sr.fs b/src/Compiler/Utilities/sr.fs index 840a9f4197c..9473cc8d78e 100644 --- a/src/Compiler/Utilities/sr.fs +++ b/src/Compiler/Utilities/sr.fs @@ -6,6 +6,7 @@ open System open Microsoft.FSharp.Core open Microsoft.FSharp.Collections open Microsoft.FSharp.Reflection +open Internal.Utilities.Library module internal SR = let private resources = @@ -20,7 +21,7 @@ module internal SR = if isNull s then System.Diagnostics.Debug.Assert(false, sprintf "**RESOURCE ERROR**: Resource token %s does not exist!" name) #endif - s + !!s module internal DiagnosticMessage = @@ -53,7 +54,7 @@ module internal DiagnosticMessage = // PERF: this technique is a bit slow (e.g. in simple cases, like 'sprintf "%x"') mkFunctionValue tys (fun inp -> impl rty inp) - let capture1 (fmt: string) i args ty (go: obj list -> System.Type -> int -> obj) : obj = + let capture1 (fmt: string) i args ty (go: objnull list -> System.Type -> int -> obj) : obj = match fmt[i] with | '%' -> go args ty (i + 1) | 'd' @@ -75,7 +76,7 @@ module internal DiagnosticMessage = if i >= len || (fmt[i] = '%' && i + 1 >= len) then let b = System.Text.StringBuilder() b.AppendFormat(messageString, (Array.ofList (List.rev args))) |> ignore - box (b.ToString()) + !!(box (b.ToString())) // REVIEW: For these purposes, this should be a nop, but I'm leaving it // in case we ever decide to support labels for the error format string // E.g., "%s%d" @@ -99,7 +100,7 @@ module internal DiagnosticMessage = // validate that the message string exists let fmtString = fmt.Value - if isNull messageString then + if isNull (box messageString) then System.Diagnostics.Debug.Assert(false, sprintf "**DECLARED MESSAGE ERROR** String resource %s does not exist" messageID) messageString <- "" @@ -149,7 +150,7 @@ module internal DiagnosticMessage = nFmt - let nHoles, holes = countFormatHoles messageString + let nHoles, holes = countFormatHoles !!messageString let nPlaceholders = countFormatPlaceholders fmtString // first, verify that the number of holes in the message string does not exceed the @@ -172,5 +173,5 @@ module internal DiagnosticMessage = ) #endif - messageString <- postProcessString messageString - new ResourceString<'T>(messageString, fmt) + messageString <- postProcessString !!messageString + new ResourceString<'T>(!!messageString, fmt) diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index 1ca53a9bc9d..34a0f40181e 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -3,6 +3,7 @@ %{ #nowarn "1182" // generated code has lots of unused "parseState" +#nowarn "3261" // the generated code would need to properly annotate nulls, e.g. changing System.Object to `obj|null` open System @@ -21,6 +22,7 @@ open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTrivia open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.SyntaxTreeOps +open FSharp.Compiler.Text open FSharp.Compiler.Text.Position open FSharp.Compiler.Text.Range open FSharp.Compiler.Xml diff --git a/src/Compiler/pppars.fsy b/src/Compiler/pppars.fsy index fb2ae8a1c32..cd27722a254 100644 --- a/src/Compiler/pppars.fsy +++ b/src/Compiler/pppars.fsy @@ -3,6 +3,8 @@ %{ open FSharp.Compiler.DiagnosticsLogger +#nowarn "3261" // the generated code would need to properly annotate nulls, e.g. changing System.Object to `obj|null` + let dummy = IfdefId("DUMMY") let doNothing _ dflt= diff --git a/src/FSharp.Build/FSharp.Build.fsproj b/src/FSharp.Build/FSharp.Build.fsproj index 70f2f534c30..3c392ef1158 100644 --- a/src/FSharp.Build/FSharp.Build.fsproj +++ b/src/FSharp.Build/FSharp.Build.fsproj @@ -4,11 +4,12 @@ Library - netstandard2.0 + netstandard2.0 netstandard2.0 FSharp.Build $(NoWarn);75 true + true $(DefineConstants);LOCALIZATION_FSBUILD $(NoWarn);NU1701;FS0075 true @@ -30,6 +31,7 @@ + diff --git a/src/FSharp.Build/FSharpEmbedResourceText.fs b/src/FSharp.Build/FSharpEmbedResourceText.fs index ebaff1986a6..60e871761c2 100644 --- a/src/FSharp.Build/FSharpEmbedResourceText.fs +++ b/src/FSharp.Build/FSharpEmbedResourceText.fs @@ -288,7 +288,8 @@ open Printf if isNull s then System.Diagnostics.Debug.Assert(false, sprintf ""**RESOURCE ERROR**: Resource token %s does not exist!"" name) #endif - s + Unchecked.nonNull s + static let mkFunctionValue (tys: System.Type[]) (impl:obj->obj) = FSharpValue.MakeFunction(FSharpType.MakeFunctionType(tys.[0],tys.[1]), impl) @@ -313,7 +314,7 @@ open Printf // PERF: this technique is a bit slow (e.g. in simple cases, like 'sprintf ""%x""') mkFunctionValue tys (fun inp -> impl rty inp) - static let capture1 (fmt:string) i args ty (go: obj list -> System.Type -> int -> obj) : obj = + static let capture1 (fmt:string) i args ty (go: objnull list -> System.Type -> int -> obj) : obj = match fmt.[i] with | '%' -> go args ty (i+1) | 'd' @@ -335,7 +336,7 @@ open Printf if i >= len || (fmt.[i] = '%' && i+1 >= len) then let b = new System.Text.StringBuilder() b.AppendFormat(messageString, [| for x in List.rev args -> x |]) |> ignore - box(b.ToString()) + box(b.ToString()) |> Unchecked.nonNull // REVIEW: For these purposes, this should be a nop, but I'm leaving it // in incase we ever decide to support labels for the error format string // E.g., ""%s%d"" diff --git a/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Nuget.fsproj b/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Nuget.fsproj index eacd502af68..4700c172f52 100644 --- a/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Nuget.fsproj +++ b/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Nuget.fsproj @@ -32,6 +32,7 @@ + diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index a1cc9169c1d..72dd62e397c 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -36,8 +36,11 @@ let rec internal spinFor (duration: TimeSpan) = return! spinFor remaining } - +#if BUILDING_WITH_LKG type internal EventRecorder<'a, 'b, 'c when 'a : equality and 'b : equality>(memoize: AsyncMemoize<'a,'b,'c>) as self = +#else +type internal EventRecorder<'a, 'b, 'c when 'a : equality and 'b : equality and 'a:not null and 'b:not null>(memoize: AsyncMemoize<'a,'b,'c>) as self = +#endif let events = ConcurrentQueue() diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj index 18a5b4d696b..bcaa3c0b991 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj @@ -85,7 +85,10 @@ - + + + TargetFramework=netstandard2.0 + diff --git a/tests/fsharp/Compiler/Libraries/Core/Unchecked/DefaultOfTests.fs b/tests/fsharp/Compiler/Libraries/Core/Unchecked/DefaultOfTests.fs index 7c732e479ad..22ee2ef107d 100644 --- a/tests/fsharp/Compiler/Libraries/Core/Unchecked/DefaultOfTests.fs +++ b/tests/fsharp/Compiler/Libraries/Core/Unchecked/DefaultOfTests.fs @@ -33,7 +33,7 @@ module ``DefaultOf Tests`` = [] let `` Unchecked defaultof reference types``() = - Assert.areEqual Unchecked.defaultof null + Assert.areEqual Unchecked.defaultof null Assert.areEqual (box Unchecked.defaultof) null Assert.areEqual (box Unchecked.defaultof) null Assert.areEqual (box Unchecked.defaultof) null diff --git a/vsintegration/src/FSharp.VS.FSI/FSharp.VS.FSI.fsproj b/vsintegration/src/FSharp.VS.FSI/FSharp.VS.FSI.fsproj index 4d65377fa4c..68cc5c4de2e 100644 --- a/vsintegration/src/FSharp.VS.FSI/FSharp.VS.FSI.fsproj +++ b/vsintegration/src/FSharp.VS.FSI/FSharp.VS.FSI.fsproj @@ -18,6 +18,7 @@ + diff --git a/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj b/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj index 374b74b5ca1..6b060d58780 100644 --- a/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj +++ b/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj @@ -15,6 +15,7 @@ + CompilerLocation.fs diff --git a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj index 5510d3dcb9c..f99bd68ec58 100644 --- a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj +++ b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj @@ -16,6 +16,7 @@ + Internal.Utilities.Collections.fsi