From 0aa7d7b7426602f73a9084d59aa8cfbd390a47e5 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 28 Apr 2023 14:50:27 +0100 Subject: [PATCH 1/7] cleanup --- src/Compiler/AbstractIL/ilread.fs | 22 +++--- src/Compiler/AbstractIL/ilreflect.fs | 14 ++-- src/Compiler/Checking/CheckExpressions.fs | 6 +- src/Compiler/Checking/MethodOverrides.fs | 2 +- src/Compiler/Checking/TypeHierarchy.fs | 73 ++++++++++--------- src/Compiler/Checking/import.fs | 7 +- src/Compiler/Checking/infos.fs | 4 +- src/Compiler/Interactive/fsi.fs | 20 +++-- .../Legacy/LegacyHostedCompilerForTesting.fs | 6 +- src/Compiler/Service/QuickParse.fs | 29 +++++--- src/Compiler/SyntaxTree/PrettyNaming.fs | 1 + src/Compiler/TypedTree/TcGlobals.fs | 30 ++++---- src/Compiler/TypedTree/TypeProviders.fs | 15 ++-- src/Compiler/TypedTree/TypedTreePickle.fs | 15 ++-- src/Compiler/Utilities/FileSystem.fs | 2 + src/Compiler/Utilities/FileSystem.fsi | 11 +++ src/Compiler/Utilities/InternalCollections.fs | 4 +- src/Compiler/Utilities/illib.fs | 4 +- src/Compiler/Utilities/illib.fsi | 4 +- src/Compiler/Utilities/lib.fs | 12 +-- 20 files changed, 162 insertions(+), 119 deletions(-) diff --git a/src/Compiler/AbstractIL/ilread.fs b/src/Compiler/AbstractIL/ilread.fs index 7c7f26a699..10189157ad 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -228,7 +228,7 @@ type WeakByteFile(fileName: string, chunk: (int * int) option) = let fileStamp = FileSystem.GetLastWriteTimeShim fileName /// The weak handle to the bytes for the file - let weakBytes = WeakReference(null) + let weakBytes = WeakReference(null) member _.FileName = fileName @@ -254,7 +254,7 @@ type WeakByteFile(fileName: string, chunk: (int * int) option) = weakBytes.SetTarget bytes - tg + nonNull tg ByteMemory.FromArray(strongBytes).AsReadOnly() @@ -941,10 +941,11 @@ let mkCacheInt32 lowMem _inbase _nm _sz = fun f (idx: int32) -> let cache = match cache with - | null -> cache <- ConcurrentDictionary(Environment.ProcessorCount, 11) - | _ -> () - - cache + | Null -> + let v = ConcurrentDictionary(Environment.ProcessorCount, 11) + cache <- v + v + | NonNull v -> v match cache.TryGetValue idx with | true, res -> @@ -969,10 +970,11 @@ let mkCacheGeneric lowMem _inbase _nm _sz = fun f (idx: 'T) -> let cache = match cache with - | null -> cache <- ConcurrentDictionary<_, _>(Environment.ProcessorCount, 11 (* sz: int *) ) - | _ -> () - - cache + | Null -> + let v = ConcurrentDictionary<_, _>(Environment.ProcessorCount, 11 (* sz: int *) ) + cache <- v + v + | NonNull v -> v match cache.TryGetValue idx with | true, v -> diff --git a/src/Compiler/AbstractIL/ilreflect.fs b/src/Compiler/AbstractIL/ilreflect.fs index f22d36e681..0d56377e36 100644 --- a/src/Compiler/AbstractIL/ilreflect.fs +++ b/src/Compiler/AbstractIL/ilreflect.fs @@ -265,7 +265,7 @@ type TypeBuilder with let t = typB.CreateTypeAndLog() let m = - if t <> null then + if box t <> null then t.GetMethod(nm, (args |> Seq.map (fun x -> x.GetType()) |> Seq.toArray)) else null @@ -546,10 +546,10 @@ let emEnv0 = delayedFieldInits = [] } -let envBindTypeRef emEnv (tref: ILTypeRef) (typT, typB, typeDef) = +let envBindTypeRef emEnv (tref: ILTypeRef) (typT: System.Type MaybeNull, typB, typeDef) = match typT with - | null -> failwithf "binding null type in envBindTypeRef: %s\n" tref.Name - | _ -> + | Null -> failwithf "binding null type in envBindTypeRef: %s\n" tref.Name + | NonNull typT -> { emEnv with emTypMap = Zmap.add tref (typT, typB, typeDef, None) emEnv.emTypMap } @@ -1018,7 +1018,7 @@ let queryableTypeGetMethod cenv emEnv parentT (mref: ILMethodRef) : MethodInfo = cconv ||| BindingFlags.Public ||| BindingFlags.NonPublic, null, argTs, - (null: ParameterModifier[]) + (null: ParameterModifier[] MaybeNull) ) // This can fail if there is an ambiguity w.r.t. return type with _ -> @@ -1102,14 +1102,14 @@ let queryableTypeGetConstructor cenv emEnv (parentT: Type) (mref: ILMethodRef) = parentT.GetConstructor(BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance, null, reqArgTs, null) match res with - | null -> + | Null -> error ( Error( FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen ("constructor", mref.Name, parentT.FullName, parentT.Assembly.FullName), range0 ) ) - | _ -> res + | NonNull res -> res let nonQueryableTypeGetConstructor (parentTI: Type) (consInfo: ConstructorInfo) : ConstructorInfo MaybeNull = if parentTI.IsGenericType then diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 367b7d8129..7f86552369 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -4332,7 +4332,7 @@ and TcTypeOrMeasure kindOpt (cenv: cenv) newOk checkConstraints occ (iwsam: Warn TcLongIdentType kindOpt cenv newOk checkConstraints occ iwsam env tpenv synLongId | MultiDimensionArrayType (rank, elemTy, m) -> - TcElementType cenv newOk checkConstraints occ env tpenv rank elemTy m + TcArrayType cenv newOk checkConstraints occ env tpenv rank elemTy m | SynType.App (StripParenTypes (SynType.LongIdent longId), _, args, _, _, postfix, m) -> TcLongIdentAppType kindOpt cenv newOk checkConstraints occ iwsam env tpenv longId postfix args m @@ -4353,7 +4353,7 @@ and TcTypeOrMeasure kindOpt (cenv: cenv) newOk checkConstraints occ (iwsam: Warn TcFunctionType cenv newOk checkConstraints occ env tpenv domainTy resultTy | SynType.Array (rank , elemTy, m) -> - TcElementType cenv newOk checkConstraints occ env tpenv rank elemTy m + TcArrayType cenv newOk checkConstraints occ env tpenv rank elemTy m | SynType.Var (tp, _) -> TcTypeParameter kindOpt cenv env newOk tpenv tp @@ -4521,7 +4521,7 @@ and TcFunctionType (cenv: cenv) newOk checkConstraints occ env tpenv domainTy re let tyR = mkFunTy g domainTyR resultTyR tyR, tpenv -and TcElementType (cenv: cenv) newOk checkConstraints occ env tpenv rank elemTy m = +and TcArrayType (cenv: cenv) newOk checkConstraints occ env tpenv rank elemTy m = let g = cenv.g let elemTy, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv elemTy let tyR = mkArrayTy g rank elemTy m diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index 58aa619bf0..314c2d4dd1 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -621,7 +621,7 @@ module DispatchSlotChecking = // dispatch slots are ordered from the derived classes to base // so we can check the topmost dispatch slot if it is final match dispatchSlots with - | meth :: _ when meth.IsFinal -> errorR(Error(FSComp.SR.tcCannotOverrideSealedMethod (sprintf "%s::%s" (meth.ApparentEnclosingType.ToString()) meth.LogicalName), m)) + | meth :: _ when meth.IsFinal -> errorR(Error(FSComp.SR.tcCannotOverrideSealedMethod((sprintf "%s::%s" (NicePrint.stringOfTy denv meth.ApparentEnclosingType) meth.LogicalName)), m)) | _ -> () /// Get the slots of a type that can or must be implemented. This depends diff --git a/src/Compiler/Checking/TypeHierarchy.fs b/src/Compiler/Checking/TypeHierarchy.fs index feaaf09e71..f6949c707d 100644 --- a/src/Compiler/Checking/TypeHierarchy.fs +++ b/src/Compiler/Checking/TypeHierarchy.fs @@ -41,44 +41,47 @@ let GetSuperTypeOfType g amap m ty = let ty = stripTyEqnsAndMeasureEqns g ty #endif - match metadataOfTy g ty with + let resBeforeNull = + match metadataOfTy g ty with #if !NO_TYPEPROVIDERS - | ProvidedTypeMetadata info -> - let st = info.ProvidedType - 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) + | ProvidedTypeMetadata info -> + let st = info.ProvidedType + 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) #endif - | ILTypeMetadata (TILObjectReprData(scoref, _, tdef)) -> - let tinst = argsOfAppTy g ty - match tdef.Extends with - | None -> None - | Some ilTy -> Some (RescopeAndImportILType scoref amap m tinst ilTy) - - | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> - if isFSharpObjModelTy g ty || isFSharpExceptionTy g ty then - let tcref = tcrefOfAppTy g ty - Some (instType (mkInstForAppTy g ty) (superOfTycon g tcref.Deref)) - elif isArrayTy g ty then - Some g.system_Array_ty - elif isRefTy g ty && not (isObjTy g ty) then - Some g.obj_ty - elif isStructTupleTy g ty then - Some g.system_Value_ty - elif isFSharpStructOrEnumTy g ty then - if isFSharpEnumTy g ty then - Some g.system_Enum_ty - else + | ILTypeMetadata (TILObjectReprData(scoref, _, tdef)) -> + let tinst = argsOfAppTy g ty + match tdef.Extends with + | None -> None + | Some ilTy -> Some (RescopeAndImportILType scoref amap m tinst ilTy) + + | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> + if isFSharpObjModelTy g ty || isFSharpExceptionTy g ty then + let tcref = tcrefOfAppTy g ty + Some (instType (mkInstForAppTy g ty) (superOfTycon g tcref.Deref)) + elif isArrayTy g ty then + Some g.system_Array_ty + elif isRefTy g ty && not (isObjTy g ty) then + Some g.obj_ty + elif isStructTupleTy g ty then + Some g.system_Value_ty + elif isFSharpStructOrEnumTy g ty then + if isFSharpEnumTy g ty then + Some g.system_Enum_ty + else + Some g.system_Value_ty + elif isStructAnonRecdTy g ty then Some g.system_Value_ty - elif isStructAnonRecdTy g ty then - Some g.system_Value_ty - elif isAnonRecdTy g ty then - Some g.obj_ty - elif isRecdTy g ty || isUnionTy g ty then - Some g.obj_ty - else - None + elif isAnonRecdTy g ty then + Some g.obj_ty + elif isRecdTy g ty || isUnionTy g ty then + Some g.obj_ty + else + None + + resBeforeNull /// Make a type for System.Collections.Generic.IList let mkSystemCollectionsGenericIListTy (g: TcGlobals) ty = diff --git a/src/Compiler/Checking/import.fs b/src/Compiler/Checking/import.fs index 03e1380124..e6a2b16099 100644 --- a/src/Compiler/Checking/import.fs +++ b/src/Compiler/Checking/import.fs @@ -38,7 +38,7 @@ type AssemblyLoader = /// Get a flag indicating if an assembly is a provided assembly, plus the /// table of information recording remappings from type names in the provided assembly to type /// names in the statically linked, embedded assembly. - abstract GetProvidedAssemblyInfo : CompilationThreadToken * range * Tainted -> bool * ProvidedAssemblyStaticLinkingMap option + abstract GetProvidedAssemblyInfo : CompilationThreadToken * range * Tainted -> bool * ProvidedAssemblyStaticLinkingMap option /// Record a root for a [] type to help guide static linking & type relocation abstract RecordGeneratedTypeRoot : ProviderGeneratedType -> unit @@ -183,12 +183,17 @@ let rec ImportILType (env: ImportMap) m tinst ty = ImportTyconRefApp env tcref inst | ILType.Byref ty -> mkByrefTy env.g (ImportILType env m tinst ty) + | ILType.Ptr ILType.Void when env.g.voidptr_tcr.CanDeref -> mkVoidPtrTy env.g + | ILType.Ptr ty -> mkNativePtrTy env.g (ImportILType env m tinst ty) + | ILType.FunctionPointer _ -> env.g.nativeint_ty (* failwith "cannot import this kind of type (ptr, fptr)" *) + | ILType.Modified(_, _, ty) -> // All custom modifiers are ignored ImportILType env m tinst ty + | ILType.TypeVar u16 -> try List.item (int u16) tinst with _ -> diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index a012d9260e..203f2fb572 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -344,8 +344,8 @@ type ILFieldInit with /// Compute the ILFieldInit for the given provided constant value for a provided enum type. static member FromProvidedObj m (v: obj) = match v with - | null -> ILFieldInit.Null - | _ -> + | Null -> ILFieldInit.Null + | NonNull v -> let objTy = v.GetType() let v = if objTy.IsEnum then objTy.GetField("value__").GetValue v else v match v with diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index f3472f256f..b09fa444fa 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -3487,7 +3487,7 @@ type FsiStdinLexerProvider IndentationAwareSyntaxStatus(initialIndentationAwareSyntaxStatus, warn = false) - let LexbufFromLineReader (fsiStdinSyphon: FsiStdinSyphon) readF = + let LexbufFromLineReader (fsiStdinSyphon: FsiStdinSyphon) (readF: unit -> string MaybeNull) = UnicodeLexing.FunctionAsLexbuf( true, tcConfigB.langVersion, @@ -3499,7 +3499,10 @@ type FsiStdinLexerProvider with :? EndOfStreamException -> None - inputOption |> Option.iter (fun t -> fsiStdinSyphon.Add(t + "\n")) + inputOption |> Option.iter (fun t -> + match t with + | Null -> () + | NonNull t -> fsiStdinSyphon.Add(t + "\n")) match inputOption with | Some null @@ -3526,11 +3529,14 @@ type FsiStdinLexerProvider // Reading stdin as a lex stream //---------------------------------------------------------------------------- - let removeZeroCharsFromString (str: string) = - if str <> null && str.Contains("\000") then - String(str |> Seq.filter (fun c -> c <> '\000') |> Seq.toArray) - else - str + let removeZeroCharsFromString (str: string MaybeNull) : string MaybeNull = + match str with + | Null -> str + | NonNull str -> + if str.Contains("\000") then + String(str |> Seq.filter (fun c -> c <> '\000') |> Seq.toArray) + else + str let CreateLexerForLexBuffer (sourceFileName, lexbuf, diagnosticsLogger) = diff --git a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs index 87ec46483f..c70bda795c 100644 --- a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs +++ b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs @@ -208,9 +208,11 @@ type internal FscCompiler(legacyReferenceResolver) = // args.[0] is later discarded, assuming it is just the path to fsc. // compensate for this in case caller didn't know let args = + match box args with + | Null -> [|"fsc"|] + | _ -> match args with - | [||] - | null -> [| "fsc" |] + | [||] -> [|"fsc"|] | a when not <| fscExeArg a[0] -> Array.append [| "fsc" |] a | _ -> args diff --git a/src/Compiler/Service/QuickParse.fs b/src/Compiler/Service/QuickParse.fs index e40d660bb2..381ba6a865 100644 --- a/src/Compiler/Service/QuickParse.fs +++ b/src/Compiler/Service/QuickParse.fs @@ -78,7 +78,7 @@ module QuickParse = | true, _, true when name.Length > 2 -> isValidStrippedName (name.AsSpan(1, name.Length - 2)) 0 | _ -> false - let GetCompleteIdentifierIslandImpl (lineStr: string) (index: int) : (string * int * bool) option = + let GetCompleteIdentifierIslandImplAux (lineStr: string) (index: int) : (string * int * bool) option = if index < 0 || isNull lineStr || index >= lineStr.Length then None else @@ -172,6 +172,11 @@ module QuickParse = let pos = r + MagicalAdjustmentConstant Some(ident, pos, false)) + let GetCompleteIdentifierIslandImpl (lineStr: string MaybeNull) (index: int) : (string * int * bool) option = + match lineStr with + | Null -> None + | NonNull lineStr -> GetCompleteIdentifierIslandImplAux lineStr index + /// Given a string and a position in that string, find an identifier as /// expected by `GotoDefinition`. This will work when the cursor is /// immediately before the identifier, within the identifier, or immediately @@ -209,10 +214,8 @@ module QuickParse = let private defaultName = [], "" /// Get the partial long name of the identifier to the left of index. - let GetPartialLongName (lineStr: string, index: int) = - if isNull lineStr then - defaultName - elif index < 0 then + let GetPartialLongNameAux (lineStr: string, index: int) = + if index < 0 then defaultName elif index >= lineStr.Length then defaultName @@ -263,16 +266,19 @@ module QuickParse = let result = InResidue(index, index) result + let GetPartialLongName (lineStr: string MaybeNull, index: int) = + match lineStr with + | Null -> defaultName + | NonNull lineStr -> GetPartialLongNameAux(lineStr, index) + type private EatCommentCallContext = | SkipWhiteSpaces of ident: string * current: string list * throwAwayNext: bool | StartIdentifier of current: string list * throwAway: bool /// Get the partial long name of the identifier to the left of index. /// For example, for `System.DateTime.Now` it returns PartialLongName ([|"System"; "DateTime"|], "Now", Some 32), where "32" pos of the last dot. - let GetPartialLongNameEx (lineStr: string, index: int) : PartialLongName = - if isNull lineStr then - PartialLongName.Empty(index) - elif index < 0 then + let GetPartialLongNameExAux (lineStr: string, index: int) : PartialLongName = + if index < 0 then PartialLongName.Empty(index) elif index >= lineStr.Length then PartialLongName.Empty(index) @@ -415,6 +421,11 @@ module QuickParse = QualifyingIdents = plid } + let GetPartialLongNameEx (lineStr: string MaybeNull, index: int) : PartialLongName = + match lineStr with + | Null -> PartialLongName.Empty(index) + | NonNull lineStr -> GetPartialLongNameExAux(lineStr, index) + let TokenNameEquals (tokenInfo: FSharpTokenInfo) (token2: string) = String.Compare(tokenInfo.TokenName, token2, StringComparison.OrdinalIgnoreCase) = 0 diff --git a/src/Compiler/SyntaxTree/PrettyNaming.fs b/src/Compiler/SyntaxTree/PrettyNaming.fs index 9c53b1f246..f78f742a03 100755 --- a/src/Compiler/SyntaxTree/PrettyNaming.fs +++ b/src/Compiler/SyntaxTree/PrettyNaming.fs @@ -1093,6 +1093,7 @@ let GetLongNameFromString x = SplitNamesForILPath x // Uncompressed OptimizationData/SignatureData name for embedded resource let FSharpOptimizationDataResourceName = "FSharpOptimizationData." + let FSharpSignatureDataResourceName = "FSharpSignatureData." // Compressed OptimizationData/SignatureData name for embedded resource diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index efa98189b8..acc036b51a 100755 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -90,21 +90,6 @@ module FSharpLib = // Access the initial environment: helpers to build references //------------------------------------------------------------------------- -// empty flags -let v_knownWithoutNull = 0uy - -let private mkNonGenericTy tcref = TType_app(tcref, [], v_knownWithoutNull) - -let mkNonLocalTyconRef2 ccu path n = mkNonLocalTyconRef (mkNonLocalEntityRef ccu path) n - -let mk_MFCore_tcref ccu n = mkNonLocalTyconRef2 ccu CorePathArray n -let mk_MFQuotations_tcref ccu n = mkNonLocalTyconRef2 ccu QuotationsPath n -let mk_MFLinq_tcref ccu n = mkNonLocalTyconRef2 ccu LinqPathArray n -let mk_MFCollections_tcref ccu n = mkNonLocalTyconRef2 ccu CollectionsPathArray n -let mk_MFCompilerServices_tcref ccu n = mkNonLocalTyconRef2 ccu CompilerServicesPath n -let mk_MFRuntimeHelpers_tcref ccu n = mkNonLocalTyconRef2 ccu RuntimeHelpersPath n -let mk_MFControl_tcref ccu n = mkNonLocalTyconRef2 ccu ControlPathArray n - type [] BuiltinAttribInfo = @@ -208,6 +193,21 @@ type TcGlobals( pathMap: PathMap, langVersion: LanguageVersion) = + // empty flags + let v_knownWithoutNull = 0uy + + let private mkNonGenericTy tcref = TType_app(tcref, [], v_knownWithoutNull) + + let mkNonLocalTyconRef2 ccu path n = mkNonLocalTyconRef (mkNonLocalEntityRef ccu path) n + + let mk_MFCore_tcref ccu n = mkNonLocalTyconRef2 ccu CorePathArray n + let mk_MFQuotations_tcref ccu n = mkNonLocalTyconRef2 ccu QuotationsPath n + let mk_MFLinq_tcref ccu n = mkNonLocalTyconRef2 ccu LinqPathArray n + let mk_MFCollections_tcref ccu n = mkNonLocalTyconRef2 ccu CollectionsPathArray n + let mk_MFCompilerServices_tcref ccu n = mkNonLocalTyconRef2 ccu CompilerServicesPath n + let mk_MFRuntimeHelpers_tcref ccu n = mkNonLocalTyconRef2 ccu RuntimeHelpersPath n + let mk_MFControl_tcref ccu n = mkNonLocalTyconRef2 ccu ControlPathArray n + let tryFindSysTypeCcu path nm = tryFindSysTypeCcuHelper path nm false diff --git a/src/Compiler/TypedTree/TypeProviders.fs b/src/Compiler/TypedTree/TypeProviders.fs index 08d2eda28d..dff177e296 100644 --- a/src/Compiler/TypedTree/TypeProviders.fs +++ b/src/Compiler/TypedTree/TypeProviders.fs @@ -230,9 +230,10 @@ let TryTypeMemberArray (st: Tainted<_>, fullName, memberName, m, f) = let TryTypeMemberNonNull<'T, 'U when 'U : null and 'U : not struct>(st: Tainted<'T>, fullName, memberName, m, recover: 'U, (f: 'T -> 'U)) : Tainted<'U> = match TryTypeMember(st, fullName, memberName, m, recover, f) with | Tainted.Null -> - errorR(Error(FSComp.SR.etUnexpectedNullFromProvidedTypeMember(fullName, memberName), m)); + errorR(Error(FSComp.SR.etUnexpectedNullFromProvidedTypeMember(fullName, memberName), m)) st.PApplyNoFailure(fun _ -> recover) - | Tainted.NonNull r -> r + | Tainted.NonNull r -> + r /// Try to access a property or method on a provided member, catching and reporting errors let TryMemberMember (mi: Tainted<_>, typeName, memberName, memberMemberName, m, recover, f) = @@ -346,7 +347,7 @@ type ProvidedType (x: Type, ctxt: ProvidedTypeContext) = x.CustomAttributes |> Seq.exists (fun a -> a.Constructor.DeclaringType.FullName = typeof.FullName) - let provide () = ProvidedCustomAttributeProvider (fun _provider -> x.CustomAttributes) :> IProvidedCustomAttributeProvider + let provide () = ProvidedCustomAttributeProvider (fun _ -> x.CustomAttributes) :> IProvidedCustomAttributeProvider interface IProvidedCustomAttributeProvider with member _.GetHasTypeProviderEditorHideMethodsAttribute provider = provide().GetHasTypeProviderEditorHideMethodsAttribute provider @@ -366,13 +367,13 @@ type ProvidedType (x: Type, ctxt: ProvidedTypeContext) = member _.IsGenericType = x.IsGenericType - member _.Namespace = x.Namespace + member _.Namespace : string MaybeNull = x.Namespace member _.FullName = x.FullName member _.IsArray = x.IsArray - member _.Assembly: ProvidedAssembly = x.Assembly |> ProvidedAssembly.Create + member _.Assembly: ProvidedAssembly MaybeNull = x.Assembly |> ProvidedAssembly.Create member _.GetInterfaces() = x.GetInterfaces() |> ProvidedType.CreateArray ctxt @@ -546,7 +547,7 @@ type ProvidedCustomAttributeProvider (attributes :ITypeProvider -> seq] type ProvidedMemberInfo (x: MemberInfo, ctxt) = - let provide () = ProvidedCustomAttributeProvider (fun _provider -> x.CustomAttributes) :> IProvidedCustomAttributeProvider + let provide () = ProvidedCustomAttributeProvider (fun _ -> x.CustomAttributes) :> IProvidedCustomAttributeProvider member _.Name = x.Name @@ -568,7 +569,7 @@ type ProvidedMemberInfo (x: MemberInfo, ctxt) = [] type ProvidedParameterInfo (x: ParameterInfo, ctxt) = - let provide () = ProvidedCustomAttributeProvider (fun _provider -> x.CustomAttributes) :> IProvidedCustomAttributeProvider + let provide () = ProvidedCustomAttributeProvider (fun _ -> x.CustomAttributes) :> IProvidedCustomAttributeProvider member _.Name = x.Name diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index c2d5a44bfd..f7f98e5620 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -754,11 +754,10 @@ let pickleObjWithDanglingCcus inMem file g scope p x = st2 st2.os - let finalBytes = phase2bytes (st1.os :> System.IDisposable).Dispose() - finalBytes + phase2bytes -let check (ilscope: ILScopeRef) (inMap : NodeInTable<_, _>) = +let check (ilscope: ILScopeRef) (inMap: NodeInTable<_, _>) = for i = 0 to inMap.Count - 1 do let n = inMap.Get i if not (inMap.IsLinked n) then @@ -1661,16 +1660,20 @@ let _ = fill_p_ty2 (fun isStructThisArgPos ty st -> p_ty2 isStructThisArgPos r st | TType_measure unt -> - p_byte 6 st; p_measure_expr unt st + p_byte 6 st + p_measure_expr unt st | TType_ucase (uc, tinst) -> - p_byte 7 st; p_tup2 p_ucref p_tys (uc, tinst) st + p_byte 7 st + p_ucref uc st + p_tys tinst st // p_byte 8 taken by TType_tuple above | TType_anon (anonInfo, l) -> p_byte 9 st p_anonInfo anonInfo st - p_tys l st) + p_tys l st + ) let _ = fill_u_ty (fun st -> let tag = u_byte st diff --git a/src/Compiler/Utilities/FileSystem.fs b/src/Compiler/Utilities/FileSystem.fs index 5148efd8ac..c1e6b79b4b 100644 --- a/src/Compiler/Utilities/FileSystem.fs +++ b/src/Compiler/Utilities/FileSystem.fs @@ -886,6 +886,8 @@ type internal ByteStream = max: int } + member b.IsEOF = (b.pos >= b.max) + member b.ReadByte() = if b.pos >= b.max then failwith "end of stream" diff --git a/src/Compiler/Utilities/FileSystem.fsi b/src/Compiler/Utilities/FileSystem.fsi index 847a86ac95..9513c227cc 100644 --- a/src/Compiler/Utilities/FileSystem.fsi +++ b/src/Compiler/Utilities/FileSystem.fsi @@ -334,16 +334,27 @@ type internal ByteMemory with /// Creates a ByteMemory object that is backed by a byte array. static member FromArray: bytes: byte[] -> ByteMemory + /// Gets a ByteMemory object that is empty + static member Empty: ByteMemory + [] type internal ByteStream = + + member IsEOF: bool + member ReadByte: unit -> byte + member ReadBytes: int -> ReadOnlyByteMemory + member ReadUtf8String: int -> string + member Position: int + static member FromBytes: ReadOnlyByteMemory * start: int * length: int -> ByteStream #if LAZY_UNPICKLE member CloneAndSeek: int -> ByteStream + member Skip: int -> unit #endif diff --git a/src/Compiler/Utilities/InternalCollections.fs b/src/Compiler/Utilities/InternalCollections.fs index 96aaf9b684..f10cd10e19 100755 --- a/src/Compiler/Utilities/InternalCollections.fs +++ b/src/Compiler/Utilities/InternalCollections.fs @@ -80,8 +80,8 @@ type internal AgedLookup<'Token, 'Key, 'Value when 'Value: not struct>(keepStron | Weak (weakReference) -> #if FX_NO_GENERIC_WEAKREFERENCE match weakReference.Target with - | null -> () - | value -> yield key, (value :?> 'Value) + | Null -> () + | NonNull value -> yield key, (value :?> 'Value) ] #else match weakReference.TryGetTarget() with diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index df7d7a6760..0e44e50e6f 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -128,14 +128,14 @@ type InlineDelayInit<'T when 'T: not struct> = } val mutable store: 'T - val mutable func: Func<'T> + val mutable func: Func<'T> MaybeNull member x.Value = match x.func with | null -> x.store | _ -> let res = LazyInitializer.EnsureInitialized(&x.store, x.func) - x.func <- Unchecked.defaultof<_> + x.func <- null res //------------------------------------------------------------------------- diff --git a/src/Compiler/Utilities/illib.fsi b/src/Compiler/Utilities/illib.fsi index c0454df4f9..642b48f855 100644 --- a/src/Compiler/Utilities/illib.fsi +++ b/src/Compiler/Utilities/illib.fsi @@ -26,8 +26,8 @@ module internal PervasiveAutoOpens = /// Returns true if the argument is non-null. val inline isNotNull: x: 'T -> bool when 'T: null - /// Indicates that a type may be null. 'MaybeNull' used internally in the F# compiler as unchecked - /// replacement for 'string?' for example for future FS-1060. + /// 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 diff --git a/src/Compiler/Utilities/lib.fs b/src/Compiler/Utilities/lib.fs index bc03a8de2a..f4c37de4cf 100755 --- a/src/Compiler/Utilities/lib.fs +++ b/src/Compiler/Utilities/lib.fs @@ -26,7 +26,10 @@ let isEnvVarSet s = let GetEnvInteger e dflt = match Environment.GetEnvironmentVariable(e) with null -> dflt | t -> try int t with _ -> dflt -let dispose (x:IDisposable) = match x with null -> () | x -> x.Dispose() +let dispose (x: IDisposable MaybeNull) = + match x with + | Null -> () + | NonNull x -> x.Dispose() //------------------------------------------------------------------------- // Library: bits @@ -329,16 +332,9 @@ type Graph<'Data, 'Id when 'Id : comparison and 'Id : equality> // with care. //---------------------------------------------------------------------------- -// The following DEBUG code does not currently compile. -//#if DEBUG -//type 'T NonNullSlot = 'T option -//let nullableSlotEmpty() = None -//let nullableSlotFull(x) = Some x -//#else type NonNullSlot<'T> = 'T let nullableSlotEmpty() = Unchecked.defaultof<'T> let nullableSlotFull x = x -//#endif //--------------------------------------------------------------------------- // Caches, mainly for free variables From 2397b338f0a2ed1847da0a456893bca5d0367cec Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 28 Apr 2023 16:45:39 +0100 Subject: [PATCH 2/7] more cleanup --- src/Compiler/Checking/CheckExpressions.fs | 4 +- src/Compiler/TypedTree/TcGlobals.fs | 2 +- src/Compiler/Utilities/illib.fs | 2 +- src/FSharp.Core/array.fs | 12 +-- src/FSharp.Core/local.fs | 50 +++++------ src/FSharp.Core/map.fs | 2 +- .../ProvidedTypes/ProvidedTypes.fs | 1 - .../TestCasesForGenerationRoundTrip/array.fsx | 4 +- .../FSharp.Core/ComparersRegression.fs | 86 +++++++++---------- .../ArrayModule.fs | 8 +- .../SeqModule2.fs | 4 +- tests/FSharp.Test.Utilities/Compiler.fs | 11 +-- .../SomethingToCompile.fs | 2 +- .../SomethingToCompileSmaller.fs | 2 +- tests/fsharp/core/array/test.fsx | 4 +- tests/fsharp/core/auto-widen/5.0/test.fsx | 48 +++++------ .../auto-widen/preview-default-warns/test.fsx | 48 +++++------ tests/fsharp/core/auto-widen/preview/test.fsx | 48 +++++------ tests/fsharp/core/byrefs/test.fsx | 2 +- tests/fsharp/core/syntax/test.fsx | 4 +- tests/fsharp/optimize/analyses/effects.fs | 6 +- .../E_ObjExprWithDuplOverride01.fs | 4 +- .../E_Sealed_Member_Override02.fsx | 6 +- .../E_Sealed_Member_Override03.fsx | 4 +- .../fsharpqa/Source/Import/E_SealedMethod.fs | 2 +- .../FSharp.ProjectSystem.FSharp/Project.fs | 2 +- .../ProvidedTypes.fs | 1 - .../Tests.ProjectSystem.Miscellaneous.fs | 6 +- 28 files changed, 187 insertions(+), 188 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 7f86552369..2618a04cb7 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -5339,8 +5339,8 @@ and TcExprUndelayedNoType (cenv: cenv) env tpenv synExpr = let expr, tpenv = TcExprUndelayed cenv (MustEqual overallTy) env tpenv synExpr expr, overallTy, tpenv -/// Process a leaf construct where the actual type (or an approximation of it such as 'list<_>' -/// or 'array<_>') is already sufficiently pre-known, and the information in the overall type +/// Process a leaf construct where the actual type (or an approximation of it such as '_ list' +/// or '_ array') is already sufficiently pre-known, and the information in the overall type /// can be eagerly propagated into the actual type (UnifyOverallType), including pre-calculating /// any type-directed conversion. This must mean that types extracted when processing the expression are not /// considered in determining any type-directed conversion. diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index acc036b51a..411c1f0d8e 100755 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -196,7 +196,7 @@ type TcGlobals( // empty flags let v_knownWithoutNull = 0uy - let private mkNonGenericTy tcref = TType_app(tcref, [], v_knownWithoutNull) + let mkNonGenericTy tcref = TType_app(tcref, [], v_knownWithoutNull) let mkNonLocalTyconRef2 ccu path n = mkNonLocalTyconRef (mkNonLocalEntityRef ccu path) n diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index 0e44e50e6f..8dbf5fd453 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -182,7 +182,7 @@ module Array = Array.length l1 = Array.length l2 && Array.forall2 p l1 l2 let order (eltOrder: IComparer<'T>) = - { new IComparer> with + { new IComparer<'T array> with member _.Compare(xs, ys) = let c = compare xs.Length ys.Length diff --git a/src/FSharp.Core/array.fs b/src/FSharp.Core/array.fs index 21fee099a9..c3de18692f 100644 --- a/src/FSharp.Core/array.fs +++ b/src/FSharp.Core/array.fs @@ -692,7 +692,7 @@ module Array = // - when the predicate yields consecutive runs of true data that is >= 32 elements (and fall // into maskArray buckets) are copied in chunks using System.Array.Copy module Filter = - let private populateMask<'a> (f: 'a -> bool) (src: array<'a>) (maskArray: array) = + let private populateMask<'a> (f: 'a -> bool) (src: 'a array) (maskArray: uint32 array) = let mutable count = 0 for maskIdx = 0 to maskArray.Length - 1 do @@ -833,8 +833,8 @@ module Array = let private createMask<'a> (f: 'a -> bool) - (src: array<'a>) - (maskArrayOut: byref>) + (src: 'a array) + (maskArrayOut: byref) (leftoverMaskOut: byref) = let maskArrayLength = src.Length / 0x20 @@ -842,7 +842,7 @@ module Array = // null when there are less than 32 items in src array. let maskArray = if maskArrayLength = 0 then - Unchecked.defaultof<_> + null else Microsoft.FSharp.Primitives.Basics.Array.zeroCreateUnchecked maskArrayLength @@ -871,7 +871,7 @@ module Array = leftoverMaskOut <- leftoverMask count - let private populateDstViaMask<'a> (src: array<'a>) (maskArray: array) (dst: array<'a>) = + let private populateDstViaMask<'a> (src: 'a array) (maskArray: uint32 array) (dst: 'a array) = let mutable dstIdx = 0 let mutable batchCount = 0 @@ -1026,7 +1026,7 @@ module Array = dstIdx - let private filterViaMask (maskArray: array) (leftoverMask: uint32) (count: int) (src: array<_>) = + let private filterViaMask (maskArray: uint32 array) (leftoverMask: uint32) (count: int) (src: _ array) = let dst = Microsoft.FSharp.Primitives.Basics.Array.zeroCreateUnchecked count let mutable dstIdx = 0 diff --git a/src/FSharp.Core/local.fs b/src/FSharp.Core/local.fs index a00cbbb43b..6a3b44f547 100644 --- a/src/FSharp.Core/local.fs +++ b/src/FSharp.Core/local.fs @@ -522,7 +522,7 @@ module internal List = loop 0 l res - let ofArray (arr:'T[]) = + let ofArray (arr:'T array) = let mutable res = ([]: 'T list) for i = arr.Length-1 downto 0 do res <- arr.[i] :: res @@ -531,7 +531,7 @@ module internal List = let inline ofSeq (e : IEnumerable<'T>) = match e with | :? ('T list) as l -> l - | :? ('T[]) as arr -> ofArray arr + | :? ('T array) as arr -> ofArray arr | _ -> use ie = e.GetEnumerator() if not (ie.MoveNext()) then [] @@ -998,35 +998,35 @@ module internal Array = let inline indexNotFound() = raise (KeyNotFoundException(SR.GetString(SR.keyNotFoundAlt))) - let findBack predicate (array: _[]) = + let findBack predicate (array: _ array) = let rec loop i = if i < 0 then indexNotFound() elif predicate array.[i] then array.[i] else loop (i - 1) loop (array.Length - 1) - let tryFindBack predicate (array: _[]) = + let tryFindBack predicate (array: _ array) = let rec loop i = if i < 0 then None elif predicate array.[i] then Some array.[i] else loop (i - 1) loop (array.Length - 1) - let findIndexBack predicate (array: _[]) = + let findIndexBack predicate (array: _ array) = let rec loop i = if i < 0 then indexNotFound() elif predicate array.[i] then i else loop (i - 1) loop (array.Length - 1) - let tryFindIndexBack predicate (array: _[]) = + let tryFindIndexBack predicate (array: _ array) = let rec loop i = if i < 0 then None elif predicate array.[i] then Some i else loop (i - 1) loop (array.Length - 1) - let permute indexMap (arr : _[]) = + let permute indexMap (arr : _ array) = let res = zeroCreateUnchecked arr.Length let inv = zeroCreateUnchecked arr.Length for i = 0 to arr.Length - 1 do @@ -1038,7 +1038,7 @@ module internal Array = if inv.[i] <> 1uy then invalidArg "indexMap" (SR.GetString(SR.notAPermutation)) res - let mapFold f acc (array : _[]) = + let mapFold f acc (array: _ array) = match array.Length with | 0 -> [| |], acc | len -> @@ -1051,7 +1051,7 @@ module internal Array = acc <- s' res, acc - let mapFoldBack f (array : _[]) acc = + let mapFoldBack f (array: _ array) acc = match array.Length with | 0 -> [| |], acc | len -> @@ -1064,7 +1064,7 @@ module internal Array = acc <- s' res, acc - let scanSubRight f (array : _[]) start fin initState = + let scanSubRight f (array: _ array) start fin initState = let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(f) let mutable state = initState let res = zeroCreateUnchecked (fin-start+2) @@ -1074,7 +1074,7 @@ module internal Array = res.[i - start] <- state res - let unstableSortInPlaceBy (projection: 'T -> 'U) (array : array<'T>) = + let unstableSortInPlaceBy (projection: 'T -> 'U) (array: 'T array) = let len = array.Length if len > 1 then let keys = zeroCreateUnchecked len @@ -1082,11 +1082,11 @@ module internal Array = keys.[i] <- projection array.[i] Array.Sort<_, _>(keys, array, fastComparerForArraySort()) - let unstableSortInPlace (array : array<'T>) = + let unstableSortInPlace (array: 'T array) = if array.Length > 1 then Array.Sort<_>(array, fastComparerForArraySort()) - let stableSortWithKeysAndComparer (cFast:IComparer<'Key>) (c:IComparer<'Key>) (array:array<'T>) (keys:array<'Key>) = + let stableSortWithKeysAndComparer (cFast:IComparer<'Key>) (c:IComparer<'Key>) (array:'T array) (keys: 'Key array) = // 'places' is an array or integers storing the permutation performed by the sort let len = array.Length let places = zeroCreateUnchecked len @@ -1094,7 +1094,7 @@ module internal Array = places.[i] <- i System.Array.Sort<_, _>(keys, places, cFast) // 'array2' is a copy of the original values - let array2 = (array.Clone() :?> array<'T>) + let array2 = (array.Clone() :?> 'T array) // Walk through any chunks where the keys are equal let mutable i = 0 @@ -1112,12 +1112,12 @@ module internal Array = Array.Sort<_, _>(places, array, i, j-i, intCompare) i <- j - let stableSortWithKeys (array:array<'T>) (keys:array<'Key>) = + let stableSortWithKeys (array:'T array) (keys:'Key array) = let cFast = fastComparerForArraySort() let c = LanguagePrimitives.FastGenericComparer<'Key> stableSortWithKeysAndComparer cFast c array keys - let stableSortInPlaceBy (projection: 'T -> 'U) (array : array<'T>) = + let stableSortInPlaceBy (projection: 'T -> 'U) (array: 'T array) = let len = array.Length if len > 1 then // 'keys' is an array storing the projected keys @@ -1126,7 +1126,7 @@ module internal Array = keys.[i] <- projection array.[i] stableSortWithKeys array keys - let stableSortInPlace (array : array<'T>) = + let stableSortInPlace (array: 'T array) = let len = array.Length if len > 1 then let cFast = LanguagePrimitives.FastGenericComparerCanBeNull<'T> @@ -1137,19 +1137,19 @@ module internal Array = Array.Sort<_, _>(array, null) | _ -> // 'keys' is an array storing the projected keys - let keys = (array.Clone() :?> array<'T>) + let keys = (array.Clone() :?> 'T array) stableSortWithKeys array keys - let stableSortInPlaceWith (comparer:'T -> 'T -> int) (array : array<'T>) = + let stableSortInPlaceWith (comparer:'T -> 'T -> int) (array: 'T array) = let len = array.Length if len > 1 then - let keys = (array.Clone() :?> array<'T>) + let keys = (array.Clone() :?> 'T array) let comparer = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(comparer) let c = { new IComparer<'T> with member _.Compare(x, y) = comparer.Invoke(x, y) } stableSortWithKeysAndComparer c c array keys - let inline subUnchecked startIndex count (array : 'T[]) = - let res = zeroCreateUnchecked count : 'T[] + let inline subUnchecked startIndex count (array: 'T array) = + let res = zeroCreateUnchecked count : 'T array if count < 64 then for i = 0 to res.Length-1 do res.[i] <- array.[startIndex+i] @@ -1157,13 +1157,13 @@ module internal Array = Array.Copy(array, startIndex, res, 0, count) res - let splitInto count (array : 'T[]) = + let splitInto count (array: 'T array) = let len = array.Length if len = 0 then [| |] else let count = min count len - let res = zeroCreateUnchecked count : 'T[][] + let res = zeroCreateUnchecked count : 'T array array let minChunkSize = len / count let mutable startIndex = 0 for i = 0 to len % count - 1 do @@ -1178,7 +1178,7 @@ module internal Seq = let tryLastV (source : seq<_>) = //checkNonNull "source" source //done in main Seq.tryLast match source with - | :? ('T[]) as a -> + | :? ('T array) as a -> if a.Length = 0 then ValueNone else ValueSome(a.[a.Length - 1]) diff --git a/src/FSharp.Core/map.fs b/src/FSharp.Core/map.fs index 2535dff752..6dfa461353 100644 --- a/src/FSharp.Core/map.fs +++ b/src/FSharp.Core/map.fs @@ -542,7 +542,7 @@ module MapTree = else acc - let ofArray comparer (arr: array<'Key * 'Value>) = + let ofArray comparer (arr: ('Key * 'Value) array) = let mutable res = empty for (x, y) in arr do diff --git a/tests/EndToEndBuildTests/ProvidedTypes/ProvidedTypes.fs b/tests/EndToEndBuildTests/ProvidedTypes/ProvidedTypes.fs index b3953588a2..1ea0a67a18 100644 --- a/tests/EndToEndBuildTests/ProvidedTypes/ProvidedTypes.fs +++ b/tests/EndToEndBuildTests/ProvidedTypes/ProvidedTypes.fs @@ -149,7 +149,6 @@ namespace ProviderImplementation.ProvidedTypes /// Internal code of .NET expects the obj[] returned by GetCustomAttributes to be an Attribute[] even in the case of empty arrays let emptyAttributes = (([| |]: Attribute[]) |> box |> unbox) - let nonNull str x = if isNull x then failwithf "Null in '%s', stacktrace = '%s'" str Environment.StackTrace else x let nonNone str x = match x with None -> failwithf "No value has been specified for '%s', stacktrace = '%s'" str Environment.StackTrace | Some v -> v let patchOption v f = match v with None -> f() | Some _ -> failwithf "Already patched, stacktrace = '%s'" Environment.StackTrace diff --git a/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/array.fsx b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/array.fsx index 82914ce60f..77307d835e 100644 --- a/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/array.fsx +++ b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/array.fsx @@ -180,7 +180,7 @@ let test_find () = with _ -> true) module Array = - let findIndexi f (array : array<_>) = + let findIndexi f (array : _ array) = let len = array.Length let rec go n = if n >= len then @@ -191,7 +191,7 @@ module Array = go (n+1) go 0 - let tryFindIndexi f (array : array<_>) = + let tryFindIndexi f (array : _ array) = let len = array.Length let rec go n = if n >= len then None elif f n array.[n] then Some n else go (n+1) go 0 diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs index a0bb9eddb6..a8e4279009 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs @@ -51,10 +51,10 @@ module ComparersRegression = union (union (raw item)) |] type Collection<'item, 'reftype, 'valuetype, 'uniontype> = { - Array : array<'item> + Array : 'item array ToRefType : 'item -> 'reftype ToValueType : 'item -> 'valuetype - ToUnionTypes : 'item -> array<'uniontype> + ToUnionTypes : 'item -> 'uniontype array } with member this.ValueWrapArray = this.Array @@ -95,7 +95,7 @@ module ComparersRegression = module Bools = type TestType = bool - let Values : array = [| true; false|] + let Values : TestType array = [| true; false|] type RefType = { Item : TestType @@ -132,7 +132,7 @@ module ComparersRegression = module NullableBools = type TestType = Nullable - let Values : array = createNullables Bools.Values + let Values : TestType array = createNullables Bools.Values type RefType = { Item : TestType @@ -171,7 +171,7 @@ module ComparersRegression = module SBytes = type TestType = sbyte - let Values : array = [| SByte.MinValue; SByte.MaxValue; -1y; 0y; +1y |] + let Values : TestType array = [| SByte.MinValue; SByte.MaxValue; -1y; 0y; +1y |] type RefType = { Item : TestType @@ -210,7 +210,7 @@ module ComparersRegression = module NullableSbytes = type TestType = Nullable - let Values : array = createNullables SBytes.Values + let Values : TestType array = createNullables SBytes.Values type RefType = { Item : TestType @@ -249,7 +249,7 @@ module ComparersRegression = module Int16s = type TestType = int16 - let Values : array = [| Int16.MaxValue; Int16.MaxValue; -1s; 0s; +1s |] + let Values : TestType array = [| Int16.MaxValue; Int16.MaxValue; -1s; 0s; +1s |] type RefType = { Item : TestType @@ -288,7 +288,7 @@ module ComparersRegression = module NullableInt16s = type TestType = Nullable - let Values : array = createNullables Int16s.Values + let Values : TestType array = createNullables Int16s.Values type RefType = { Item : TestType @@ -327,7 +327,7 @@ module ComparersRegression = module Int32s = type TestType = int32 - let Values : array = [| Int32.MinValue; Int32.MaxValue; -1; 0; +1 |] + let Values : TestType array = [| Int32.MinValue; Int32.MaxValue; -1; 0; +1 |] type RefType = { Item : TestType @@ -366,7 +366,7 @@ module ComparersRegression = module NullableInt32s = type TestType = Nullable - let Values : array = createNullables Int32s.Values + let Values : TestType array = createNullables Int32s.Values type RefType = { Item : TestType @@ -405,7 +405,7 @@ module ComparersRegression = module Int64s = type TestType = int64 - let Values : array = [| Int64.MinValue; Int64.MaxValue; -1L; 0L; +1L |] + let Values : TestType array = [| Int64.MinValue; Int64.MaxValue; -1L; 0L; +1L |] type RefType = { Item : TestType @@ -444,7 +444,7 @@ module ComparersRegression = module NullableInt64s = type TestType = Nullable - let Values : array = createNullables Int64s.Values + let Values : TestType array = createNullables Int64s.Values type RefType = { Item : TestType @@ -483,7 +483,7 @@ module ComparersRegression = module NativeInts = type TestType = nativeint - let Values : array = [| -1n; 0n; +1n |] + let Values : TestType array = [| -1n; 0n; +1n |] type RefType = { Item : TestType @@ -522,7 +522,7 @@ module ComparersRegression = module NullableNativeInts = type TestType = Nullable - let Values : array = createNullables NativeInts.Values + let Values : TestType array = createNullables NativeInts.Values type RefType = { Item : TestType @@ -561,7 +561,7 @@ module ComparersRegression = module Bytes = type TestType = byte - let Values : array = [| Byte.MinValue; Byte.MaxValue; 0uy; 1uy; 2uy |] + let Values : TestType array = [| Byte.MinValue; Byte.MaxValue; 0uy; 1uy; 2uy |] type RefType = { Item : TestType @@ -600,7 +600,7 @@ module ComparersRegression = module NullableBytes = type TestType = Nullable - let Values : array = createNullables Bytes.Values + let Values : TestType array = createNullables Bytes.Values type RefType = { Item : TestType @@ -639,7 +639,7 @@ module ComparersRegression = module Uint16s = type TestType = uint16 - let Values : array = [| UInt16.MinValue; UInt16.MaxValue; 0us; 1us; 2us |] + let Values : TestType array = [| UInt16.MinValue; UInt16.MaxValue; 0us; 1us; 2us |] type RefType = { Item : TestType @@ -678,7 +678,7 @@ module ComparersRegression = module NullableUInt16s = type TestType = Nullable - let Values : array = createNullables Uint16s.Values + let Values : TestType array = createNullables Uint16s.Values type RefType = { Item : TestType @@ -717,7 +717,7 @@ module ComparersRegression = module UInt32s = type TestType = uint32 - let Values : array = [| UInt32.MinValue; UInt32.MaxValue; 0u; 1u; 2u|] + let Values : TestType array = [| UInt32.MinValue; UInt32.MaxValue; 0u; 1u; 2u|] type RefType = { Item : TestType @@ -756,7 +756,7 @@ module ComparersRegression = module NullableUInt32s = type TestType = Nullable - let Values : array = createNullables UInt32s.Values + let Values : TestType array = createNullables UInt32s.Values type RefType = { Item : TestType @@ -795,7 +795,7 @@ module ComparersRegression = module UInt64s = type TestType = uint64 - let Values : array = [| UInt64.MinValue; UInt64.MaxValue; 0UL; 1UL; 2UL|] + let Values : TestType array = [| UInt64.MinValue; UInt64.MaxValue; 0UL; 1UL; 2UL|] type RefType = { Item : TestType @@ -834,7 +834,7 @@ module ComparersRegression = module NullableUInt64s = type TestType = Nullable - let Values : array = createNullables UInt64s.Values + let Values : TestType array = createNullables UInt64s.Values type RefType = { Item : TestType @@ -873,7 +873,7 @@ module ComparersRegression = module UNativeInts = type TestType = unativeint - let Values : array = [| 0un; 1un; 2un |] + let Values : TestType array = [| 0un; 1un; 2un |] type RefType = { Item : TestType @@ -912,7 +912,7 @@ module ComparersRegression = module NullableUNativeInts = type TestType = Nullable - let Values : array = createNullables UNativeInts.Values + let Values : TestType array = createNullables UNativeInts.Values type RefType = { Item : TestType @@ -951,7 +951,7 @@ module ComparersRegression = module Chars = type TestType = char - let Values : array = [| Char.MinValue; Char.MaxValue; '0'; '1'; '2' |] + let Values : TestType array = [| Char.MinValue; Char.MaxValue; '0'; '1'; '2' |] type RefType = { Item : TestType @@ -990,7 +990,7 @@ module ComparersRegression = module NullableChars = type TestType = Nullable - let Values : array = createNullables Chars.Values + let Values : TestType array = createNullables Chars.Values type RefType = { Item : TestType @@ -1029,7 +1029,7 @@ module ComparersRegression = module Strings = type TestType = string - let Values : array = [| null; String.Empty; "Hello, world!"; String('\u0000', 3); "\u0061\u030a"; "\u00e5" |] + let Values : TestType array = [| null; String.Empty; "Hello, world!"; String('\u0000', 3); "\u0061\u030a"; "\u00e5" |] type RefType = { Item : TestType @@ -1068,7 +1068,7 @@ module ComparersRegression = module Decimals = type TestType = decimal - let Values : array = [| Decimal.MinValue; Decimal.MaxValue; Decimal.MinusOne; Decimal.Zero; Decimal.One |] + let Values : TestType array = [| Decimal.MinValue; Decimal.MaxValue; Decimal.MinusOne; Decimal.Zero; Decimal.One |] type RefType = { Item : TestType @@ -1107,7 +1107,7 @@ module ComparersRegression = module NullableDecimals = type TestType = Nullable - let Values : array = createNullables Decimals.Values + let Values : TestType array = createNullables Decimals.Values type RefType = { Item : TestType @@ -1146,7 +1146,7 @@ module ComparersRegression = module Floats = type TestType = float - let Values : array = [| Double.MinValue; Double.MaxValue; Double.Epsilon; Double.NaN; Double.NegativeInfinity; Double.PositiveInfinity; -1.; 0.; 1. |] + let Values : TestType array = [| Double.MinValue; Double.MaxValue; Double.Epsilon; Double.NaN; Double.NegativeInfinity; Double.PositiveInfinity; -1.; 0.; 1. |] type RefType = { Item : TestType @@ -1185,7 +1185,7 @@ module ComparersRegression = module NullableFloats = type TestType = Nullable - let Values : array = createNullables Floats.Values + let Values : TestType array = createNullables Floats.Values type RefType = { Item : TestType @@ -1224,7 +1224,7 @@ module ComparersRegression = module Float32s = type TestType = float32 - let Values : array = [| Single.MinValue; Single.MaxValue; Single.Epsilon; Single.NaN; Single.NegativeInfinity; Single.PositiveInfinity; -1.f; 0.f; 1.f |] + let Values : TestType array = [| Single.MinValue; Single.MaxValue; Single.Epsilon; Single.NaN; Single.NegativeInfinity; Single.PositiveInfinity; -1.f; 0.f; 1.f |] type RefType = { Item : TestType @@ -1263,7 +1263,7 @@ module ComparersRegression = module NullableFloat32s = type TestType = Nullable - let Values : array = createNullables Float32s.Values + let Values : TestType array = createNullables Float32s.Values type RefType = { Item : TestType @@ -1302,7 +1302,7 @@ module ComparersRegression = module DateTimes = type TestType = System.DateTime - let Values : array = [| DateTime.MinValue; DateTime.MaxValue; DateTime(2015, 10, 8, 5, 39, 23) |] + let Values : TestType array = [| DateTime.MinValue; DateTime.MaxValue; DateTime(2015, 10, 8, 5, 39, 23) |] type RefType = { Item : TestType @@ -1341,7 +1341,7 @@ module ComparersRegression = module NullableDateTimes = type TestType = Nullable - let Values : array = createNullables DateTimes.Values + let Values : TestType array = createNullables DateTimes.Values type RefType = { Item : TestType @@ -1380,7 +1380,7 @@ module ComparersRegression = module Tuple2s = type TestType = float*float - let Values : array = [| (nan, nan); (nan, 0.0); (0.0, nan); (0.0, 0.0) |] + let Values : TestType array = [| (nan, nan); (nan, 0.0); (0.0, nan); (0.0, 0.0) |] type RefType = { Item : TestType @@ -1418,7 +1418,7 @@ module ComparersRegression = module Tuple3s = type TestType = float*float*float - let Values : array = [| + let Values : TestType array = [| (nan, nan, nan); (nan, nan, 0.0); (nan, 0.0, nan); (nan, 0.0, 0.0); (0.0, nan, nan); (0.0, nan, 0.0); (0.0, 0.0, nan); (0.0, 0.0, 0.0) |] @@ -1459,7 +1459,7 @@ module ComparersRegression = module Tuple4s = type TestType = float*float*float*float - let Values : array = [| + let Values : TestType array = [| (nan, nan, nan, nan); (nan, nan, nan, 0.0); (nan, nan, 0.0, nan); (nan, nan, 0.0, 0.0); (nan, 0.0, nan, nan); (nan, 0.0, nan, 0.0); (nan, 0.0, 0.0, nan); (nan, 0.0, 0.0, 0.0); (0.0, nan, nan, nan); (0.0, nan, nan, 0.0); (0.0, nan, 0.0, nan); (0.0, nan, 0.0, 0.0); @@ -1503,7 +1503,7 @@ module ComparersRegression = module Tuple5s = type TestType = float*float*float*float*float - let Values : array = [| + let Values : TestType array = [| (nan, nan, nan, nan, nan); (nan, nan, nan, nan, 0.0); (nan, nan, nan, 0.0, nan); (nan, nan, nan, 0.0, 0.0); (nan, nan, 0.0, nan, nan); (nan, nan, 0.0, nan, 0.0); (nan, nan, 0.0, 0.0, nan); (nan, nan, 0.0, 0.0, 0.0); (nan, 0.0, nan, nan, nan); (nan, 0.0, nan, nan, 0.0); (nan, 0.0, nan, 0.0, nan); (nan, 0.0, nan, 0.0, 0.0); @@ -1629,7 +1629,7 @@ module ComparersRegression = static member N = noninlinable module TestGenerationMethods = - let create<'a,'b when 'b : equality> name operation (f:IOperation<'a>) (items:array<'a>) = + let create<'a,'b when 'b : equality> name operation (f:IOperation<'a>) (items: 'a array) = printf """ [] member _.``%s %s``() = validate (%s) %s """ name operation name operation @@ -1643,7 +1643,7 @@ module ComparersRegression = printf "%d" result) printfn "\n |]\n" - let create_inequalities name (items:array<'a>) = + let create_inequalities name (items: 'a array) = create name "C.I.equals" C.I.equals items create name "C.I.equal" C.I.equal items create name "C.I.not_equal" C.I.not_equal items @@ -1661,7 +1661,7 @@ module ComparersRegression = create name "C.N.greater_than" C.N.greater_than items create name "C.N.greater_or_equal" C.N.greater_or_equal items - let create_equalities name (items:array<'a>) = + let create_equalities name (items: 'a array) = create name "E.I.equals" E.I.equals items create name "E.I.equal" E.I.equal items create name "E.I.not_equal" E.I.not_equal items @@ -1737,7 +1737,7 @@ module ComparersRegression = create_tuples_tests "Tuple5s.Collection" Tuple5s.Collection - let validate (items:array<'a>) (f:IOperation<'a>) (expected:array) = + let validate (items: 'a array) (f:IOperation<'a>) (expected: int array) = try make_result_set f items (Some expected) |> ignore with diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Collections/ArrayModule.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Collections/ArrayModule.fs index 7508047545..0f9931e0e6 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Collections/ArrayModule.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Collections/ArrayModule.fs @@ -748,7 +748,7 @@ type ArrayModule() = array - let checkFilter filter (array:array<_>) = + let checkFilter filter (array: _ array) = let filtered = array |> filter (fun n -> n > 0) let mutable idx = 0 @@ -1588,7 +1588,7 @@ type ArrayModule() = member this.``pairwise should not work on null``() = CheckThrowsArgumentNullException(fun () -> Array.pairwise null |> ignore) - member private this.MapTester mapInt (mapString : (string -> int) -> array -> array) = + member private this.MapTester mapInt (mapString : (string -> int) -> string array -> int array) = // empty array let f x = x + 1 let result = mapInt f [| |] @@ -1635,11 +1635,11 @@ type ArrayModule() = if result <> [| |] then Assert.Fail () // int array - let result : array = mapiInt f [| 1..2 |] + let result : (int*int) array = mapiInt f [| 1..2 |] if result <> [| (0,2); (1,3) |] then Assert.Fail () // string array - let result : array = [| "a"; "aa"; "aaa" |] |> mapiString (fun i (s:string) -> i, s.Length) + let result : (int*int) array = [| "a"; "aa"; "aaa" |] |> mapiString (fun i (s:string) -> i, s.Length) if result <> [| (0,1); (1,2); (2,3) |] then Assert.Fail () // null array diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Collections/SeqModule2.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Collections/SeqModule2.fs index 2252fdc3ac..8412b999b5 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Collections/SeqModule2.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Collections/SeqModule2.fs @@ -113,7 +113,7 @@ type SeqModule2() = CheckThrowsArgumentException ( fun() -> Seq.last emptyArr) // null Array - let nullArr: array<'a> = null + let nullArr: 'a array = null CheckThrowsArgumentNullException (fun () ->Seq.last nullArr) // ---- Test for IList ----- @@ -185,7 +185,7 @@ type SeqModule2() = Assert.True(emptyResult.IsNone) // null Array - let nullArr:array = null + let nullArr: unit array = null CheckThrowsArgumentNullException (fun () -> Seq.tryLast nullArr |> ignore) diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index d702509def..d73ed201fd 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -260,11 +260,12 @@ module rec Compiler = let private getWarnings diagnostics = diagnostics |> List.filter (fun e -> match e.Error with Warning _ -> true | _ -> false) let private adjustRange (range: Range) (adjust: int) : Range = - { range with - StartLine = range.StartLine - adjust - StartColumn = range.StartColumn + 1 - EndLine = range.EndLine - adjust - EndColumn = range.EndColumn + 1 } + { + StartLine = range.StartLine - adjust + StartColumn = range.StartColumn + 1 + EndLine = range.EndLine - adjust + EndColumn = range.EndColumn + 1 + } let FsxSourceCode source = SourceCodeFileKind.Fsx({FileName="test.fsx"; SourceText=Some source}) diff --git a/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/SomethingToCompile.fs b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/SomethingToCompile.fs index c7d44a39b3..6d3e9bd2cd 100644 --- a/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/SomethingToCompile.fs +++ b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/SomethingToCompile.fs @@ -191,7 +191,7 @@ module Array = Array.length l1 = Array.length l2 && Array.forall2 p l1 l2 let order (eltOrder: IComparer<'T>) = - { new IComparer> with + { new IComparer<'T array> with member _.Compare(xs, ys) = let c = compare xs.Length ys.Length diff --git a/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/SomethingToCompileSmaller.fs b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/SomethingToCompileSmaller.fs index d1c8214683..77ec52cf2a 100644 --- a/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/SomethingToCompileSmaller.fs +++ b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/SomethingToCompileSmaller.fs @@ -191,7 +191,7 @@ module Array = Array.length l1 = Array.length l2 && Array.forall2 p l1 l2 let order (eltOrder: IComparer<'T>) = - { new IComparer> with + { new IComparer<'T array> with member _.Compare(xs, ys) = let c = compare xs.Length ys.Length diff --git a/tests/fsharp/core/array/test.fsx b/tests/fsharp/core/array/test.fsx index e9d208db69..49b7a1f303 100644 --- a/tests/fsharp/core/array/test.fsx +++ b/tests/fsharp/core/array/test.fsx @@ -180,7 +180,7 @@ let test_find () = with _ -> true) module Array = - let findIndexi f (array : array<_>) = + let findIndexi f (array : _ array) = let len = array.Length let rec go n = if n >= len then @@ -191,7 +191,7 @@ module Array = go (n+1) go 0 - let tryFindIndexi f (array : array<_>) = + let tryFindIndexi f (array : _ array) = let len = array.Length let rec go n = if n >= len then None elif f n array.[n] then Some n else go (n+1) go 0 diff --git a/tests/fsharp/core/auto-widen/5.0/test.fsx b/tests/fsharp/core/auto-widen/5.0/test.fsx index 1905c5977d..c5ec8bf854 100644 --- a/tests/fsharp/core/auto-widen/5.0/test.fsx +++ b/tests/fsharp/core/auto-widen/5.0/test.fsx @@ -310,25 +310,25 @@ let f1 () : obj = 1 let f2 () : obj = if true then 1 else 3.0 module TestComputedListExpressionsAtList = - let x1 : list = [ yield 1 ] - let x2 : list = [ yield 1; + let x1 : int64 list = [ yield 1 ] + let x2 : int64 list = [ yield 1; if true then yield 2L ] - let x3 : list = [ yield 1L; + let x3 : int64 list = [ yield 1L; if true then yield 2 ] - let x4 : list = [ yield 1L; + let x4 : int64 list = [ yield 1L; while false do yield 2 ] - let x5 : list = [ yield 1; + let x5 : int64 list = [ yield 1; while false do yield 2L ] - let x6 : list = [ while false do yield 2L ] - let x7 : list = [ for i in 0 .. 10 do yield 2 ] - let x8 : list = [ yield 1L + let x6 : int64 list = [ while false do yield 2L ] + let x7 : int64 list = [ for i in 0 .. 10 do yield 2 ] + let x8 : int64 list = [ yield 1L for i in 0 .. 10 do yield 2 ] - let x9 : list = [ yield 1 + let x9 : int64 list = [ yield 1 for i in 0 .. 10 do yield 2L ] - let x10 : list = [ try yield 2 finally () ] - let x11 : list = [ yield 1L + let x10 : int64 list = [ try yield 2 finally () ] + let x11 : int64 list = [ yield 1L try yield 2 finally () ] - let x12 : list = [ yield 1 + let x12 : int64 list = [ yield 1 try yield 2L finally () ] module TestComputedListExpressionsAtSeq = @@ -365,25 +365,25 @@ module TestComputedListExpressionsAtSeq = try yield 2L finally () ] module TestComputedArrayExpressionsAtArray = - let x1 : array = [| yield 1 |] - let x2 : array = [| yield 1; + let x1 : int64 array = [| yield 1 |] + let x2 : int64 array = [| yield 1; if true then yield 2L |] - let x3 : array = [| yield 1L; + let x3 : int64 array = [| yield 1L; if true then yield 2 |] - let x4 : array = [| yield 1L; + let x4 : int64 array = [| yield 1L; while false do yield 2 |] - let x5 : array = [| yield 1; + let x5 : int64 array = [| yield 1; while false do yield 2L |] - let x6 : array = [| while false do yield 2L |] - let x7 : array = [| for i in 0 .. 10 do yield 2 |] - let x8 : array = [| yield 1L + let x6 : int64 array = [| while false do yield 2L |] + let x7 : int64 array = [| for i in 0 .. 10 do yield 2 |] + let x8 : int64 array = [| yield 1L for i in 0 .. 10 do yield 2 |] - let x9 : array = [| yield 1 + let x9 : int64 array = [| yield 1 for i in 0 .. 10 do yield 2L |] - let x10 : array = [| try yield 2 finally () |] - let x11 : array = [| yield 1L + let x10 : int64 array = [| try yield 2 finally () |] + let x11 : int64 array = [| yield 1L try yield 2 finally () |] - let x12 : array = [| yield 1 + let x12 : int64 array = [| yield 1 try yield 2L finally () |] module TestComputedArrayExpressionsAtSeq = diff --git a/tests/fsharp/core/auto-widen/preview-default-warns/test.fsx b/tests/fsharp/core/auto-widen/preview-default-warns/test.fsx index 753a70f94a..a716574395 100644 --- a/tests/fsharp/core/auto-widen/preview-default-warns/test.fsx +++ b/tests/fsharp/core/auto-widen/preview-default-warns/test.fsx @@ -310,25 +310,25 @@ let f1 () : obj = 1 let f2 () : obj = if true then 1 else 3.0 module TestComputedListExpressionsAtList = - let x1 : list = [ yield 1 ] - let x2 : list = [ yield 1; + let x1 : int64 list = [ yield 1 ] + let x2 : int64 list = [ yield 1; if true then yield 2L ] - let x3 : list = [ yield 1L; + let x3 : int64 list = [ yield 1L; if true then yield 2 ] - let x4 : list = [ yield 1L; + let x4 : int64 list = [ yield 1L; while false do yield 2 ] - let x5 : list = [ yield 1; + let x5 : int64 list = [ yield 1; while false do yield 2L ] - let x6 : list = [ while false do yield 2L ] - let x7 : list = [ for i in 0 .. 10 do yield 2 ] - let x8 : list = [ yield 1L + let x6 : int64 list = [ while false do yield 2L ] + let x7 : int64 list = [ for i in 0 .. 10 do yield 2 ] + let x8 : int64 list = [ yield 1L for i in 0 .. 10 do yield 2 ] - let x9 : list = [ yield 1 + let x9 : int64 list = [ yield 1 for i in 0 .. 10 do yield 2L ] - let x10 : list = [ try yield 2 finally () ] - let x11 : list = [ yield 1L + let x10 : int64 list = [ try yield 2 finally () ] + let x11 : int64 list = [ yield 1L try yield 2 finally () ] - let x12 : list = [ yield 1 + let x12 : int64 list = [ yield 1 try yield 2L finally () ] module TestComputedListExpressionsAtSeq = @@ -365,25 +365,25 @@ module TestComputedListExpressionsAtSeq = try yield 2L finally () ] module TestComputedArrayExpressionsAtArray = - let x1 : array = [| yield 1 |] - let x2 : array = [| yield 1; + let x1 : int64 array = [| yield 1 |] + let x2 : int64 array = [| yield 1; if true then yield 2L |] - let x3 : array = [| yield 1L; + let x3 : int64 array = [| yield 1L; if true then yield 2 |] - let x4 : array = [| yield 1L; + let x4 : int64 array = [| yield 1L; while false do yield 2 |] - let x5 : array = [| yield 1; + let x5 : int64 array = [| yield 1; while false do yield 2L |] - let x6 : array = [| while false do yield 2L |] - let x7 : array = [| for i in 0 .. 10 do yield 2 |] - let x8 : array = [| yield 1L + let x6 : int64 array = [| while false do yield 2L |] + let x7 : int64 array = [| for i in 0 .. 10 do yield 2 |] + let x8 : int64 array = [| yield 1L for i in 0 .. 10 do yield 2 |] - let x9 : array = [| yield 1 + let x9 : int64 array = [| yield 1 for i in 0 .. 10 do yield 2L |] - let x10 : array = [| try yield 2 finally () |] - let x11 : array = [| yield 1L + let x10 : int64 array = [| try yield 2 finally () |] + let x11 : int64 array = [| yield 1L try yield 2 finally () |] - let x12 : array = [| yield 1 + let x12 : int64 array = [| yield 1 try yield 2L finally () |] module TestComputedArrayExpressionsAtSeq = diff --git a/tests/fsharp/core/auto-widen/preview/test.fsx b/tests/fsharp/core/auto-widen/preview/test.fsx index 8d17aa78da..bd484c4b34 100644 --- a/tests/fsharp/core/auto-widen/preview/test.fsx +++ b/tests/fsharp/core/auto-widen/preview/test.fsx @@ -310,25 +310,25 @@ let f1 () : obj = 1 let f2 () : obj = if true then 1 else 3.0 module TestComputedListExpressionsAtList = - let x1 : list = [ yield 1 ] - let x2 : list = [ yield 1; + let x1 : int64 list = [ yield 1 ] + let x2 : int64 list = [ yield 1; if true then yield 2L ] - let x3 : list = [ yield 1L; + let x3 : int64 list = [ yield 1L; if true then yield 2 ] - let x4 : list = [ yield 1L; + let x4 : int64 list = [ yield 1L; while false do yield 2 ] - let x5 : list = [ yield 1; + let x5 : int64 list = [ yield 1; while false do yield 2L ] - let x6 : list = [ while false do yield 2L ] - let x7 : list = [ for i in 0 .. 10 do yield 2 ] - let x8 : list = [ yield 1L + let x6 : int64 list = [ while false do yield 2L ] + let x7 : int64 list = [ for i in 0 .. 10 do yield 2 ] + let x8 : int64 list = [ yield 1L for i in 0 .. 10 do yield 2 ] - let x9 : list = [ yield 1 + let x9 : int64 list = [ yield 1 for i in 0 .. 10 do yield 2L ] - let x10 : list = [ try yield 2 finally () ] - let x11 : list = [ yield 1L + let x10 : int64 list = [ try yield 2 finally () ] + let x11 : int64 list = [ yield 1L try yield 2 finally () ] - let x12 : list = [ yield 1 + let x12 : int64 list = [ yield 1 try yield 2L finally () ] module TestComputedListExpressionsAtSeq = @@ -365,25 +365,25 @@ module TestComputedListExpressionsAtSeq = try yield 2L finally () ] module TestComputedArrayExpressionsAtArray = - let x1 : array = [| yield 1 |] - let x2 : array = [| yield 1; + let x1 : int64 array = [| yield 1 |] + let x2 : int64 array = [| yield 1; if true then yield 2L |] - let x3 : array = [| yield 1L; + let x3 : int64 array = [| yield 1L; if true then yield 2 |] - let x4 : array = [| yield 1L; + let x4 : int64 array = [| yield 1L; while false do yield 2 |] - let x5 : array = [| yield 1; + let x5 : int64 array = [| yield 1; while false do yield 2L |] - let x6 : array = [| while false do yield 2L |] - let x7 : array = [| for i in 0 .. 10 do yield 2 |] - let x8 : array = [| yield 1L + let x6 : int64 array = [| while false do yield 2L |] + let x7 : int64 array = [| for i in 0 .. 10 do yield 2 |] + let x8 : int64 array = [| yield 1L for i in 0 .. 10 do yield 2 |] - let x9 : array = [| yield 1 + let x9 : int64 array = [| yield 1 for i in 0 .. 10 do yield 2L |] - let x10 : array = [| try yield 2 finally () |] - let x11 : array = [| yield 1L + let x10 : int64 array = [| try yield 2 finally () |] + let x11 : int64 array = [| yield 1L try yield 2 finally () |] - let x12 : array = [| yield 1 + let x12 : int64 array = [| yield 1 try yield 2L finally () |] module TestComputedArrayExpressionsAtSeq = diff --git a/tests/fsharp/core/byrefs/test.fsx b/tests/fsharp/core/byrefs/test.fsx index 25f739a103..ad3623e1d3 100644 --- a/tests/fsharp/core/byrefs/test.fsx +++ b/tests/fsharp/core/byrefs/test.fsx @@ -104,7 +104,7 @@ module ByrefNegativeTests = let test1 () = let aggregator = new ConcurrentDictionary< - string, ConcurrentDictionary> + string, ConcurrentDictionary >() for kvp in aggregator do diff --git a/tests/fsharp/core/syntax/test.fsx b/tests/fsharp/core/syntax/test.fsx index 8ca6dbc98e..6818915094 100644 --- a/tests/fsharp/core/syntax/test.fsx +++ b/tests/fsharp/core/syntax/test.fsx @@ -31,8 +31,8 @@ test "line number test" (__LINE__ = "100") test "line number test" (__LINE__ = "102") test "line number test" (__SOURCE_FILE__ = "file.fs") -# 29 "original-test-file.fs" -test "line number test" (__LINE__ = "29") +# 35 "original-test-file.fs" +test "line number test" (__LINE__ = "35") test "line number test" (__SOURCE_FILE__ = "original-test-file.fs") diff --git a/tests/fsharp/optimize/analyses/effects.fs b/tests/fsharp/optimize/analyses/effects.fs index f204199fb5..8382fb61b3 100644 --- a/tests/fsharp/optimize/analyses/effects.fs +++ b/tests/fsharp/optimize/analyses/effects.fs @@ -32,13 +32,13 @@ module BasicAnalysisTests = let rec infiniteLoop2 (x1:int) (x2:int) : int = infiniteLoop2 x1 x2 let callGenericInfiniteLoop (x:'a) : 'a = genericInfiniteLoop x - let rec loopViaModuleFunction1 (f: 'T -> bool) (arr:array<'T>) i = + let rec loopViaModuleFunction1 (f: 'T -> bool) (arr: 'T array) i = loopViaModuleFunction1 f arr (i+1) - let rec loopViaModuleFunction (f: 'T -> bool) (arr:array<'T>) i = + let rec loopViaModuleFunction (f: 'T -> bool) (arr: 'T array) i = i >= arr.Length || (f arr.[i] && loopViaModuleFunction f arr (i+1)) - let loopViaInnerFunction (f: 'T -> bool) (array:array<'T>) = + let loopViaInnerFunction (f: 'T -> bool) (array: 'T array) = let len = array.Length let rec loop i = i >= len || (f array.[i] && loop (i+1)) loop 0 diff --git a/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/ObjectExpressions/E_ObjExprWithDuplOverride01.fs b/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/ObjectExpressions/E_ObjExprWithDuplOverride01.fs index 10c4974b6a..8621a19d33 100644 --- a/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/ObjectExpressions/E_ObjExprWithDuplOverride01.fs +++ b/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/ObjectExpressions/E_ObjExprWithDuplOverride01.fs @@ -7,13 +7,13 @@ [] type BaseHashtable<'Entry, 'Key>(initialCapacity) = - abstract member Next : entries : array<'Entry> -> int + abstract member Next : entries : 'Entry array -> int [] type StrongToWeakEntry<'Value when 'Value : not struct> = val mutable public next : int let f() = { new BaseHashtable<_,_>(2) with - override this.Next (entries:array>) = 1 + override this.Next (entries:StrongToWeakEntry<_> array) = 1 override this.Next entries = 1 } diff --git a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_Sealed_Member_Override02.fsx b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_Sealed_Member_Override02.fsx index d2eb3f460a..30a0858758 100644 --- a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_Sealed_Member_Override02.fsx +++ b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_Sealed_Member_Override02.fsx @@ -22,9 +22,9 @@ type T4() = inherit CSLib5.B1() override x.M(i : int) = 2 // ERROR {expected} -//Cannot override inherited member 'B1::M' because it is sealed$ -//Cannot override inherited member 'B1::M' because it is sealed$ -//Cannot override inherited member 'B1::M' because it is sealed$ +//Cannot override inherited member 'CSLib.B1::M' because it is sealed$ +//Cannot override inherited member 'CSLib2.B1::M' because it is sealed$ +//Cannot override inherited member 'CSLib4.B1::M' because it is sealed$ //No implementation was given for those members: // 'CSLib5\.B0\.M\(c: char, a: int\) : int' // 'CSLib5\.B0\.N\(c: char, a: int\) : int' diff --git a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_Sealed_Member_Override03.fsx b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_Sealed_Member_Override03.fsx index 9414401cb1..5767cfa602 100644 --- a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_Sealed_Member_Override03.fsx +++ b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_Sealed_Member_Override03.fsx @@ -14,5 +14,5 @@ type T2() = override x.M(o : obj) = 12 override x.M(i : int) = 2 // ERROR {expected} -//Cannot override inherited member 'B1::M' because it is sealed$ -//Cannot override inherited member 'B1::M' because it is sealed$ \ No newline at end of file +//Cannot override inherited member 'CSLib.B1::M' because it is sealed$ +//Cannot override inherited member 'CSLib2.B1::M' because it is sealed$ \ No newline at end of file diff --git a/tests/fsharpqa/Source/Import/E_SealedMethod.fs b/tests/fsharpqa/Source/Import/E_SealedMethod.fs index c3e4790d3d..2abecd6704 100644 --- a/tests/fsharpqa/Source/Import/E_SealedMethod.fs +++ b/tests/fsharpqa/Source/Import/E_SealedMethod.fs @@ -1,6 +1,6 @@ // #Regression #NoMT #Import // Dev11 Bug 90642 -//Cannot override inherited member 'Class2::F' because it is sealed$ +//Cannot override inherited member 'ClassLibrary1.Class2::F' because it is sealed$ type MyClass() = inherit ClassLibrary1.Class2() diff --git a/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs b/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs index 4be4c71d30..c5e347878a 100644 --- a/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs +++ b/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs @@ -344,7 +344,7 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem let mutable vsProject : VSLangProj.VSProject = null let mutable trackDocumentsHandle = 0u - let mutable addFilesNotification : option<(array -> unit)> = None // this object is only used for helping re-order newly added files (VS defaults to alphabetical order) + let mutable addFilesNotification : (string array -> unit) option = None // this object is only used for helping re-order newly added files (VS defaults to alphabetical order) let mutable updateSolnEventsHandle = 0u let mutable updateSolnEventsHandle2 = 0u diff --git a/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/ProvidedTypes.fs b/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/ProvidedTypes.fs index 4a7bc2764f..ae593e9961 100644 --- a/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/ProvidedTypes.fs +++ b/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/ProvidedTypes.fs @@ -149,7 +149,6 @@ namespace ProviderImplementation.ProvidedTypes /// Internal code of .NET expects the obj[] returned by GetCustomAttributes to be an Attribute[] even in the case of empty arrays let emptyAttributes = (([| |]: Attribute[]) |> box |> unbox) - let nonNull str x = if isNull x then failwithf "Null in '%s', stacktrace = '%s'" str Environment.StackTrace else x let nonNone str x = match x with None -> failwithf "No value has been specified for '%s', stacktrace = '%s'" str Environment.StackTrace | Some v -> v let patchOption v f = match v with None -> f() | Some _ -> failwithf "Already patched, stacktrace = '%s'" Environment.StackTrace diff --git a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.Miscellaneous.fs b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.Miscellaneous.fs index 143c75ec45..1a0e16a2aa 100644 --- a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.Miscellaneous.fs +++ b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.Miscellaneous.fs @@ -203,9 +203,9 @@ type Miscellaneous() = let prjCfg = project.ConfigProvider.GetProjectConfiguration(new ConfigCanonicalName("Debug","AnyCPU")) :> IVsProjectCfg2 let count = [| 0u |] prjCfg.get_OutputGroups(0u, null, count) |> ValidateOK - let ogs : array = Array.create (int count.[0]) null + let ogs : IVsOutputGroup array = Array.create (int count.[0]) null prjCfg.get_OutputGroups(count.[0], ogs, count) |> ValidateOK - let ogs : array = ogs |> Array.map (fun x -> downcast x) + let ogs : IVsOutputGroup2 array = ogs |> Array.map (fun x -> downcast x) let ogInfos = [for og in ogs do let mutable canonicalName = "" @@ -218,7 +218,7 @@ type Miscellaneous() = let keyOutputResult = og.get_KeyOutput(&keyOutput) let count = [| 0u |] og.get_Outputs(0u, null, count) |> ValidateOK - let os : array = Array.create (int count.[0]) null + let os : IVsOutput2 array = Array.create (int count.[0]) null og.get_Outputs(count.[0], os, count) |> ValidateOK yield canonicalName, description, displayName, keyOutput, keyOutputResult, [ for o in os do From c269fe35212da012a122f132ef8a85682fa79aba Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 28 Apr 2023 17:43:04 +0100 Subject: [PATCH 3/7] fantomas --- src/Compiler/Interactive/fsi.fs | 3 ++- .../Legacy/LegacyHostedCompilerForTesting.fs | 12 ++++++------ src/Compiler/Utilities/illib.fsi | 2 +- 3 files changed, 9 insertions(+), 8 deletions(-) diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index b09fa444fa..395635a320 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -3499,7 +3499,8 @@ type FsiStdinLexerProvider with :? EndOfStreamException -> None - inputOption |> Option.iter (fun t -> + inputOption + |> Option.iter (fun t -> match t with | Null -> () | NonNull t -> fsiStdinSyphon.Add(t + "\n")) diff --git a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs index c70bda795c..5982b97df2 100644 --- a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs +++ b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs @@ -209,12 +209,12 @@ type internal FscCompiler(legacyReferenceResolver) = // compensate for this in case caller didn't know let args = match box args with - | Null -> [|"fsc"|] - | _ -> - match args with - | [||] -> [|"fsc"|] - | a when not <| fscExeArg a[0] -> Array.append [| "fsc" |] a - | _ -> args + | Null -> [| "fsc" |] + | _ -> + match args with + | [||] -> [| "fsc" |] + | a when not <| fscExeArg a[0] -> Array.append [| "fsc" |] a + | _ -> args let errorRanges = args |> Seq.exists errorRangesArg let vsErrors = args |> Seq.exists vsErrorsArg diff --git a/src/Compiler/Utilities/illib.fsi b/src/Compiler/Utilities/illib.fsi index 642b48f855..7272dace37 100644 --- a/src/Compiler/Utilities/illib.fsi +++ b/src/Compiler/Utilities/illib.fsi @@ -26,7 +26,7 @@ module internal PervasiveAutoOpens = /// Returns true if the argument is non-null. val inline isNotNull: x: 'T -> bool when 'T: null - /// Indicates that a type may be null. 'MaybeNull' is used internally in the F# compiler as + /// 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 From 8c99d7b127819792e153cc19692ca7f09b5ef116 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 28 Apr 2023 17:59:17 +0100 Subject: [PATCH 4/7] cleanup --- .../Legacy/LegacyHostedCompilerForTesting.fs | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs index 5982b97df2..87ec46483f 100644 --- a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs +++ b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs @@ -208,13 +208,11 @@ type internal FscCompiler(legacyReferenceResolver) = // args.[0] is later discarded, assuming it is just the path to fsc. // compensate for this in case caller didn't know let args = - match box args with - | Null -> [| "fsc" |] - | _ -> - match args with - | [||] -> [| "fsc" |] - | a when not <| fscExeArg a[0] -> Array.append [| "fsc" |] a - | _ -> args + match args with + | [||] + | null -> [| "fsc" |] + | a when not <| fscExeArg a[0] -> Array.append [| "fsc" |] a + | _ -> args let errorRanges = args |> Seq.exists errorRangesArg let vsErrors = args |> Seq.exists vsErrorsArg From b07d7ae9ff57eb1e192a0b49dd2f9cf03d20e0e8 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 28 Apr 2023 23:28:29 +0100 Subject: [PATCH 5/7] transfer a few more changes --- src/Compiler/Checking/ConstraintSolver.fs | 4 +++- src/Compiler/Checking/MethodCalls.fs | 8 ++++---- src/Compiler/Checking/import.fs | 19 +++++++++++-------- src/Compiler/Checking/infos.fs | 22 +++++++++++----------- src/Compiler/CodeGen/EraseUnions.fs | 8 ++++---- src/Compiler/CodeGen/IlxGen.fs | 4 ++-- src/FSharp.Core/array.fs | 2 +- 7 files changed, 36 insertions(+), 31 deletions(-) diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 6b0ef85d5e..22ebc3ca4d 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -1203,7 +1203,9 @@ and SolveTypeEqualsType (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr if not (typarsAEquiv g aenv tps1 tps2) then localAbortD else SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace bodyTy1 bodyTy2 - | TType_ucase (uc1, l1), TType_ucase (uc2, l2) when g.unionCaseRefEq uc1 uc2 -> SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2 + | TType_ucase (uc1, l1), TType_ucase (uc2, l2) when g.unionCaseRefEq uc1 uc2 -> + SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2 + | _ -> localAbortD and SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty1 ty2 = diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 870443d32b..ceb13545da 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -1067,7 +1067,7 @@ let MakeMethInfoCall (amap: ImportMap) m (minfo: MethInfo) minst args staticTyOp let isProp = false // not necessarily correct, but this is only used post-creflect where this flag is irrelevant let ilMethodRef = Import.ImportProvidedMethodBaseAsILMethodRef amap m mi let isConstructor = mi.PUntaint((fun c -> c.IsConstructor), m) - let isStruct = mi.PUntaint((fun c -> c.DeclaringType.IsValueType), m) + let isStruct = mi.PUntaint((fun c -> (nonNull c.DeclaringType).IsValueType), m) let actualTypeInst = [] // GENERIC TYPE PROVIDERS: for generics, we would have something here let actualMethInst = [] // GENERIC TYPE PROVIDERS: for generics, we would have something here let ilReturnTys = Option.toList (minfo.GetCompiledReturnType(amap, m, [])) // GENERIC TYPE PROVIDERS: for generics, we would have more here @@ -1080,7 +1080,7 @@ let MakeMethInfoCall (amap: ImportMap) m (minfo: MethInfo) minst args staticTyOp // This imports a provided method, and checks if it is a known compiler intrinsic like "1 + 2" let TryImportProvidedMethodBaseAsLibraryIntrinsic (amap: Import.ImportMap, m: range, mbase: Tainted) = let methodName = mbase.PUntaint((fun x -> x.Name), m) - let declaringType = Import.ImportProvidedType amap m (mbase.PApply((fun x -> x.DeclaringType), m)) + let declaringType = Import.ImportProvidedType amap m (mbase.PApply((fun x -> nonNull x.DeclaringType), m)) match tryTcrefOfAppTy amap.g declaringType with | ValueSome declaringEntity -> if not declaringEntity.IsLocalRef && ccuEq declaringEntity.nlr.Ccu amap.g.fslibCcu then @@ -2042,7 +2042,7 @@ module ProvidedMethodCalls = let thisArg, paramVars = match objArgs with | [objArg] -> - let erasedThisTy = eraseSystemType (amap, m, mi.PApply((fun mi -> mi.DeclaringType), m)) + let erasedThisTy = eraseSystemType (amap, m, mi.PApply((fun mi -> nonNull mi.DeclaringType), m)) let thisVar = erasedThisTy.PApply((fun ty -> ty.AsProvidedVar("this")), m) Some objArg, Array.append [| thisVar |] paramVars | [] -> None, paramVars @@ -2062,7 +2062,7 @@ module ProvidedMethodCalls = methInfoOpt, expr, exprTy with | :? TypeProviderError as tpe -> - let typeName = mi.PUntaint((fun mb -> mb.DeclaringType.FullName), m) + let typeName = mi.PUntaint((fun mb -> (nonNull mb.DeclaringType).FullName), m) let methName = mi.PUntaint((fun mb -> mb.Name), m) raise( tpe.WithContext(typeName, methName) ) // loses original stack trace #endif diff --git a/src/Compiler/Checking/import.fs b/src/Compiler/Checking/import.fs index e6a2b16099..bf6c9e7300 100644 --- a/src/Compiler/Checking/import.fs +++ b/src/Compiler/Checking/import.fs @@ -195,9 +195,12 @@ let rec ImportILType (env: ImportMap) m tinst ty = ImportILType env m tinst ty | ILType.TypeVar u16 -> - try List.item (int u16) tinst - with _ -> - error(Error(FSComp.SR.impNotEnoughTypeParamsInScopeWhileImporting(), m)) + let ty = + try + List.item (int u16) tinst + with _ -> + error(Error(FSComp.SR.impNotEnoughTypeParamsInScopeWhileImporting(), m)) + ty /// Determines if an IL type can be imported as an F# type let rec CanImportILType (env: ImportMap) m ty = @@ -359,15 +362,15 @@ let rec ImportProvidedType (env: ImportMap) (m: range) (* (tinst: TypeInst) *) ( /// Import a provided method reference as an Abstract IL method reference let ImportProvidedMethodBaseAsILMethodRef (env: ImportMap) (m: range) (mbase: Tainted) = - let tref = GetILTypeRefOfProvidedType (mbase.PApply((fun mbase -> mbase.DeclaringType), m), m) + let tref = GetILTypeRefOfProvidedType (mbase.PApply((fun mbase -> nonNull mbase.DeclaringType), m), m) let mbase = // Find the formal member corresponding to the called member match mbase.OfType() with | Some minfo when - minfo.PUntaint((fun minfo -> minfo.IsGenericMethod|| minfo.DeclaringType.IsGenericType), m) -> + minfo.PUntaint((fun minfo -> minfo.IsGenericMethod|| (nonNull minfo.DeclaringType).IsGenericType), m) -> - let declaringType = minfo.PApply((fun minfo -> minfo.DeclaringType), m) + let declaringType = minfo.PApply((fun minfo -> nonNull minfo.DeclaringType), m) let declaringGenericTypeDefn = if declaringType.PUntaint((fun t -> t.IsGenericType), m) then @@ -386,8 +389,8 @@ let ImportProvidedMethodBaseAsILMethodRef (env: ImportMap) (m: range) (mbase: Ta error(Error(FSComp.SR.etIncorrectProvidedMethod(DisplayNameOfTypeProvider(minfo.TypeProvider, m), methodName, metadataToken, typeName), m)) | _ -> match mbase.OfType() with - | Some cinfo when cinfo.PUntaint((fun x -> x.DeclaringType.IsGenericType), m) -> - let declaringType = cinfo.PApply((fun x -> x.DeclaringType), m) + | Some cinfo when cinfo.PUntaint((fun x -> (nonNull x.DeclaringType).IsGenericType), m) -> + let declaringType = cinfo.PApply((fun x -> nonNull x.DeclaringType), m) let declaringGenericTypeDefn = declaringType.PApply((fun x -> x.GetGenericTypeDefinition()), m) // We have to find the uninstantiated formal signature corresponding to this instantiated constructor. diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index 203f2fb572..2fe6031aea 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -75,7 +75,7 @@ type ValRef with let GetCompiledReturnTyOfProvidedMethodInfo amap m (mi: Tainted) = let returnType = if mi.PUntaint((fun mi -> mi.IsConstructor), m) then - mi.PApply((fun mi -> mi.DeclaringType), m) + mi.PApply((fun mi -> nonNull mi.DeclaringType), m) else mi.Coerce(m).PApply((fun mi -> mi.ReturnType), m) let ty = ImportProvidedType amap m returnType if isVoidTy amap.g ty then None else Some ty @@ -393,8 +393,8 @@ let OptionalArgInfoOfProvidedParameter (amap: ImportMap) m (provParam : Tainted< /// Compute the ILFieldInit for the given provided constant value for a provided enum type. let GetAndSanityCheckProviderMethod m (mi: Tainted<'T :> ProvidedMemberInfo>) (get : 'T -> ProvidedMethodInfo MaybeNull) err = - match mi.PApply((fun mi -> (get mi :> ProvidedMethodBase)), m) with - | Tainted.Null -> error(Error(err(mi.PUntaint((fun mi -> mi.Name), m), mi.PUntaint((fun mi -> mi.DeclaringType.Name), m)), m)) + match mi.PApply((fun mi -> (get mi :> ProvidedMethodBase MaybeNull)),m) with + | Tainted.Null -> error(Error(err(mi.PUntaint((fun mi -> mi.Name),m),mi.PUntaint((fun mi -> (nonNull mi.DeclaringType).Name), m)), m)) // TODO NULLNESS: type isntantiation should not be needed | meth -> meth /// Try to get an arbitrary ProvidedMethodInfo associated with a property. @@ -404,7 +404,7 @@ let ArbitraryMethodInfoOfPropertyInfo (pi: Tainted) m = elif pi.PUntaint((fun pi -> pi.CanWrite), m) then GetAndSanityCheckProviderMethod m pi (fun pi -> pi.GetSetMethod()) FSComp.SR.etPropertyCanWriteButHasNoSetter else - error(Error(FSComp.SR.etPropertyNeedsCanWriteOrCanRead(pi.PUntaint((fun mi -> mi.Name), m), pi.PUntaint((fun mi -> mi.DeclaringType.Name), m)), m)) + error(Error(FSComp.SR.etPropertyNeedsCanWriteOrCanRead(pi.PUntaint((fun mi -> mi.Name), m), pi.PUntaint((fun mi -> (nonNull mi.DeclaringType).Name), m)), m)) #endif @@ -649,7 +649,7 @@ type MethInfo = | DefaultStructCtor(_, ty) -> ty #if !NO_TYPEPROVIDERS | ProvidedMeth(amap, mi, _, m) -> - ImportProvidedType amap m (mi.PApply((fun mi -> mi.DeclaringType), m)) + ImportProvidedType amap m (mi.PApply((fun mi -> nonNull mi.DeclaringType), m)) #endif /// Get the enclosing type of the method info, using a nominal type for tuple types @@ -1137,7 +1137,7 @@ type MethInfo = | DefaultStructCtor _ -> [] #if !NO_TYPEPROVIDERS | ProvidedMeth(amap, mi, _, m) -> - if x.IsInstance then [ ImportProvidedType amap m (mi.PApply((fun mi -> mi.DeclaringType), m)) ] // find the type of the 'this' argument + if x.IsInstance then [ ImportProvidedType amap m (mi.PApply((fun mi -> nonNull mi.DeclaringType), m)) ] // find the type of the 'this' argument else [] #endif @@ -1296,7 +1296,7 @@ type MethInfo = let paramTy = match p.PApply((fun p -> p.ParameterType), m) with | Tainted.Null -> amap.g.unit_ty - | parameterType -> ImportProvidedType amap m parameterType + | Tainted.NonNull parameterType -> ImportProvidedType amap m parameterType yield ParamNameAndType(paramName, paramTy) ] ] #endif @@ -1349,7 +1349,7 @@ type ILFieldInfo = match x with | ILFieldInfo(tinfo, _) -> tinfo.ToType #if !NO_TYPEPROVIDERS - | ProvidedField(amap, fi, m) -> (ImportProvidedType amap m (fi.PApply((fun fi -> fi.DeclaringType), m))) + | ProvidedField(amap, fi, m) -> (ImportProvidedType amap m (fi.PApply((fun fi -> nonNull fi.DeclaringType), m))) #endif member x.ApparentEnclosingAppType = x.ApparentEnclosingType @@ -1370,7 +1370,7 @@ type ILFieldInfo = match x with | ILFieldInfo(tinfo, _) -> tinfo.ILTypeRef #if !NO_TYPEPROVIDERS - | ProvidedField(amap, fi, m) -> (ImportProvidedTypeAsILType amap m (fi.PApply((fun fi -> fi.DeclaringType), m))).TypeRef + | ProvidedField(amap, fi, m) -> (ImportProvidedTypeAsILType amap m (fi.PApply((fun fi -> nonNull fi.DeclaringType), m))).TypeRef #endif /// Get the scope used to interpret IL metadata @@ -1664,7 +1664,7 @@ type PropInfo = | FSProp(_, ty, _, _) -> ty #if !NO_TYPEPROVIDERS | ProvidedProp(amap, pi, m) -> - ImportProvidedType amap m (pi.PApply((fun pi -> pi.DeclaringType), m)) + ImportProvidedType amap m (pi.PApply((fun pi -> nonNull pi.DeclaringType), m)) #endif /// Get the enclosing type of the method info, using a nominal type for tuple types @@ -2112,7 +2112,7 @@ type EventInfo = | ILEvent ileinfo -> ileinfo.ApparentEnclosingType | FSEvent (_, p, _, _) -> p.ApparentEnclosingType #if !NO_TYPEPROVIDERS - | ProvidedEvent (amap, ei, m) -> ImportProvidedType amap m (ei.PApply((fun ei -> ei.DeclaringType), m)) + | ProvidedEvent (amap, ei, m) -> ImportProvidedType amap m (ei.PApply((fun ei -> nonNull ei.DeclaringType), m)) #endif /// Get the enclosing type of the method info, using a nominal type for tuple types diff --git a/src/Compiler/CodeGen/EraseUnions.fs b/src/Compiler/CodeGen/EraseUnions.fs index 9d4d9bcefe..58c82e4d9b 100644 --- a/src/Compiler/CodeGen/EraseUnions.fs +++ b/src/Compiler/CodeGen/EraseUnions.fs @@ -1006,7 +1006,7 @@ let convAlternativeDef [ mkILParamNamed ("obj", altTy) ], mkMethodBody (false, [], 3, debugProxyCode, None, imports) )) - .With(customAttrs = mkILCustomAttrs[GetDynamicDependencyAttribute g 0x660 baseTy]) + .With(customAttrs = mkILCustomAttrs [GetDynamicDependencyAttribute g 0x660 baseTy]) |> addMethodGeneratedAttrs let debugProxyGetterMeths = @@ -1128,7 +1128,7 @@ let convAlternativeDef let basicCtorMeth = (mkILStorageCtor (basicCtorInstrs, altTy, basicCtorFields, basicCtorAccess, attr, imports)) - .With(customAttrs = mkILCustomAttrs[GetDynamicDependencyAttribute g 0x660 baseTy]) + .With(customAttrs = mkILCustomAttrs [GetDynamicDependencyAttribute g 0x660 baseTy]) |> addMethodGeneratedAttrs let altTypeDef = @@ -1261,7 +1261,7 @@ let mkClassUnionDef cud.DebugPoint, cud.DebugImports )) - .With(customAttrs = mkILCustomAttrs[GetDynamicDependencyAttribute g 0x660 baseTy]) + .With(customAttrs = mkILCustomAttrs [GetDynamicDependencyAttribute g 0x660 baseTy]) |> addMethodGeneratedAttrs let props, meths = @@ -1319,7 +1319,7 @@ let mkClassUnionDef cud.DebugPoint, cud.DebugImports )) - .With(customAttrs = mkILCustomAttrs[GetDynamicDependencyAttribute g 0x7E0 baseTy]) + .With(customAttrs = mkILCustomAttrs [GetDynamicDependencyAttribute g 0x7E0 baseTy]) |> addMethodGeneratedAttrs ] diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 0db2e1af8b..66cd89d14e 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -2065,7 +2065,7 @@ type AnonTypeGenerationTable() = let ilCtorDef = (mkILSimpleStorageCtorWithParamNames (ilBaseTySpec, ilTy, [], flds, ILMemberAccess.Public, None, None)) - .With(customAttrs = mkILCustomAttrs[GetDynamicDependencyAttribute g 0x660 ilTy]) + .With(customAttrs = mkILCustomAttrs [GetDynamicDependencyAttribute g 0x660 ilTy]) // Create a tycon that looks exactly like a record definition, to help drive the generation of equality/comparison code let m = range0 @@ -11013,7 +11013,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = None, eenv.imports )) - .With(customAttrs = mkILCustomAttrs[GetDynamicDependencyAttribute g 0x660 ilThisTy]) + .With(customAttrs = mkILCustomAttrs [GetDynamicDependencyAttribute g 0x660 ilThisTy]) yield ilMethodDef // FSharp 1.0 bug 1988: Explicitly setting the ComVisible(true) attribute on an F# type causes an F# record to be emitted in a way that enables mutation for COM interop scenarios diff --git a/src/FSharp.Core/array.fs b/src/FSharp.Core/array.fs index c3de18692f..c3f9d35cdc 100644 --- a/src/FSharp.Core/array.fs +++ b/src/FSharp.Core/array.fs @@ -1049,7 +1049,7 @@ module Array = dst - let filter f (src: array<_>) = + let filter f (src: _ array) = let mutable maskArray = Unchecked.defaultof<_> let mutable leftOverMask = Unchecked.defaultof<_> From 69b4ffb27fb8868284bf5d3681567fa524ff8419 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 28 Apr 2023 23:34:17 +0100 Subject: [PATCH 6/7] fantomas --- src/Compiler/CodeGen/EraseUnions.fs | 8 ++++---- src/Compiler/CodeGen/IlxGen.fs | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Compiler/CodeGen/EraseUnions.fs b/src/Compiler/CodeGen/EraseUnions.fs index 58c82e4d9b..5dcd60c9a1 100644 --- a/src/Compiler/CodeGen/EraseUnions.fs +++ b/src/Compiler/CodeGen/EraseUnions.fs @@ -1006,7 +1006,7 @@ let convAlternativeDef [ mkILParamNamed ("obj", altTy) ], mkMethodBody (false, [], 3, debugProxyCode, None, imports) )) - .With(customAttrs = mkILCustomAttrs [GetDynamicDependencyAttribute g 0x660 baseTy]) + .With(customAttrs = mkILCustomAttrs [ GetDynamicDependencyAttribute g 0x660 baseTy ]) |> addMethodGeneratedAttrs let debugProxyGetterMeths = @@ -1128,7 +1128,7 @@ let convAlternativeDef let basicCtorMeth = (mkILStorageCtor (basicCtorInstrs, altTy, basicCtorFields, basicCtorAccess, attr, imports)) - .With(customAttrs = mkILCustomAttrs [GetDynamicDependencyAttribute g 0x660 baseTy]) + .With(customAttrs = mkILCustomAttrs [ GetDynamicDependencyAttribute g 0x660 baseTy ]) |> addMethodGeneratedAttrs let altTypeDef = @@ -1261,7 +1261,7 @@ let mkClassUnionDef cud.DebugPoint, cud.DebugImports )) - .With(customAttrs = mkILCustomAttrs [GetDynamicDependencyAttribute g 0x660 baseTy]) + .With(customAttrs = mkILCustomAttrs [ GetDynamicDependencyAttribute g 0x660 baseTy ]) |> addMethodGeneratedAttrs let props, meths = @@ -1319,7 +1319,7 @@ let mkClassUnionDef cud.DebugPoint, cud.DebugImports )) - .With(customAttrs = mkILCustomAttrs [GetDynamicDependencyAttribute g 0x7E0 baseTy]) + .With(customAttrs = mkILCustomAttrs [ GetDynamicDependencyAttribute g 0x7E0 baseTy ]) |> addMethodGeneratedAttrs ] diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 66cd89d14e..98e0003e43 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -2065,7 +2065,7 @@ type AnonTypeGenerationTable() = let ilCtorDef = (mkILSimpleStorageCtorWithParamNames (ilBaseTySpec, ilTy, [], flds, ILMemberAccess.Public, None, None)) - .With(customAttrs = mkILCustomAttrs [GetDynamicDependencyAttribute g 0x660 ilTy]) + .With(customAttrs = mkILCustomAttrs [ GetDynamicDependencyAttribute g 0x660 ilTy ]) // Create a tycon that looks exactly like a record definition, to help drive the generation of equality/comparison code let m = range0 @@ -11013,7 +11013,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = None, eenv.imports )) - .With(customAttrs = mkILCustomAttrs [GetDynamicDependencyAttribute g 0x660 ilThisTy]) + .With(customAttrs = mkILCustomAttrs [ GetDynamicDependencyAttribute g 0x660 ilThisTy ]) yield ilMethodDef // FSharp 1.0 bug 1988: Explicitly setting the ComVisible(true) attribute on an F# type causes an F# record to be emitted in a way that enables mutation for COM interop scenarios From 69b4e858daf16f0f0afd0dea3cca995eb3071b10 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sat, 29 Apr 2023 00:09:18 +0100 Subject: [PATCH 7/7] fix build --- .../MemberDeclarations/E_Sealed_Member_Override02.fsx | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_Sealed_Member_Override02.fsx b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_Sealed_Member_Override02.fsx index 30a0858758..08eb1ecdaf 100644 --- a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_Sealed_Member_Override02.fsx +++ b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_Sealed_Member_Override02.fsx @@ -29,4 +29,4 @@ type T4() = // 'CSLib5\.B0\.M\(c: char, a: int\) : int' // 'CSLib5\.B0\.N\(c: char, a: int\) : int' //This type is 'abstract' since some abstract members have not been given an implementation\. If this is intentional then add the '\[\]' attribute to your type\.$ -//Cannot override inherited member 'B1::M' because it is sealed$ \ No newline at end of file +//Cannot override inherited member 'CSLib5.B1::M' because it is sealed$ \ No newline at end of file