Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions .fantomasignore
Original file line number Diff line number Diff line change
Expand Up @@ -117,6 +117,9 @@ src/Compiler/Facilities/AsyncMemoize.fsi
src/Compiler/Facilities/AsyncMemoize.fs
src/Compiler/AbstractIL/il.fs

src/Compiler/Driver/GraphChecking/Graph.fsi
src/Compiler/Driver/GraphChecking/Graph.fs

# Fantomas limitations on implementation files (to investigate)

src/Compiler/AbstractIL/ilwrite.fs
Expand Down
2 changes: 1 addition & 1 deletion docs/release-notes/.FSharp.Compiler.Service/9.0.200.md
Original file line number Diff line number Diff line change
@@ -1,11 +1,11 @@
### Fixed

* Fix false negatives for passing null to "obj" arguments. Only "obj | null" can now subsume any type ([PR #17757](https://github.com/dotnet/fsharp/pull/17757))
* Fix internal error when calling 'AddSingleton' and other overloads only differing in generic arity ([PR #17804](https://github.com/dotnet/fsharp/pull/17804))
* Fix extension methods support for non-reference system assemblies ([PR #17799](https://github.com/dotnet/fsharp/pull/17799))
* Ensure `frameworkTcImportsCache` mutations are thread-safe. ([PR #17795](https://github.com/dotnet/fsharp/pull/17795))
* Fix concurrency issue in `ILPreTypeDefImpl` ([PR #17812](https://github.com/dotnet/fsharp/pull/17812))


### Added


Expand Down
2 changes: 1 addition & 1 deletion src/Compiler/AbstractIL/ilreflect.fs
Original file line number Diff line number Diff line change
Expand Up @@ -277,7 +277,7 @@ type TypeBuilder with

match m with
| null -> raise (MissingMethodException nm)
| m -> m.Invoke(null, args)
| m -> m.Invoke(null, (args: obj array))

member typB.SetCustomAttributeAndLog(cinfo, bytes) =
if logRefEmitCalls then
Expand Down
4 changes: 2 additions & 2 deletions src/Compiler/Checking/AttributeChecking.fs
Original file line number Diff line number Diff line change
Expand Up @@ -466,9 +466,9 @@ let MethInfoIsUnseen g (m: range) (ty: TType) minfo =

let isUnseenByHidingAttribute () =
#if !NO_TYPEPROVIDERS
not (isObjTy g ty) &&
not (isObjTyAnyNullness g ty) &&
isAppTy g ty &&
isObjTy g minfo.ApparentEnclosingType &&
isObjTyAnyNullness g minfo.ApparentEnclosingType &&
let tcref = tcrefOfAppTy g ty
match tcref.TypeReprInfo with
| TProvidedTypeRepr info ->
Expand Down
1,287 changes: 650 additions & 637 deletions src/Compiler/Checking/ConstraintSolver.fs

Large diffs are not rendered by default.

10 changes: 5 additions & 5 deletions src/Compiler/Checking/Expressions/CheckExpressions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -3283,7 +3283,7 @@ let AnalyzeArbitraryExprAsEnumerable (cenv: cenv) (env: TcEnv) localAlloc m expr

let enumElemTy =

if isObjTy g enumElemTy then
if isObjTyAnyNullness g enumElemTy then
// Look for an 'Item' property, or a set of these with consistent return types
let allEquivReturnTypes (minfo: MethInfo) (others: MethInfo list) =
let returnTy = minfo.GetFSharpReturnType(cenv.amap, m, [])
Expand Down Expand Up @@ -6195,7 +6195,7 @@ and TcExprObjectExpr (cenv: cenv) overallTy env tpenv (synObjTy, argopt, binds,
errorR(Error(FSComp.SR.tcCannotInheritFromErasedType(), m))
(m, intfTy, overrides), tpenv)

let realObjTy = if isObjTy g objTy && not (isNil extraImpls) then (p23 (List.head extraImpls)) else objTy
let realObjTy = if isObjTyAnyNullness g objTy && not (isNil extraImpls) then (p23 (List.head extraImpls)) else objTy

TcPropagatingExprLeafThenConvert cenv overallTy realObjTy env (* canAdhoc *) m (fun () ->
TcObjectExpr cenv env tpenv (objTy, realObjTy, argopt, binds, extraImpls, mObjTy, mNewExpr, m)
Expand Down Expand Up @@ -7320,7 +7320,7 @@ and TcFormatStringExpr cenv (overallTy: OverallTy) env m tpenv (fmtString: strin
let formatTy = mkPrintfFormatTy g aty bty cty dty ety

// This might qualify as a format string - check via a type directed rule
let ok = not (isObjTy g overallTy.Commit) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy.Commit formatTy
let ok = not (isObjTyAnyNullness g overallTy.Commit) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy.Commit formatTy

if ok then
// Parse the format string to work out the phantom types
Expand Down Expand Up @@ -7399,7 +7399,7 @@ and TcInterpolatedStringExpr cenv (overallTy: OverallTy) env m tpenv (parts: Syn
Choice1Of2 (true, newFormatMethod)

// ... or if that fails then may be a FormattableString by a type-directed rule....
elif (not (isObjTy g overallTy.Commit) &&
elif (not (isObjTyAnyNullness g overallTy.Commit) &&
((g.system_FormattableString_tcref.CanDeref && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy.Commit g.system_FormattableString_ty)
|| (g.system_IFormattable_tcref.CanDeref && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy.Commit g.system_IFormattable_ty))) then

Expand All @@ -7420,7 +7420,7 @@ and TcInterpolatedStringExpr cenv (overallTy: OverallTy) env m tpenv (parts: Syn
| None -> languageFeatureNotSupportedInLibraryError LanguageFeature.StringInterpolation m

// ... or if that fails then may be a PrintfFormat by a type-directed rule....
elif not (isObjTy g overallTy.Commit) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy.Commit formatTy then
elif not (isObjTyAnyNullness g overallTy.Commit) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy.Commit formatTy then

// And if that succeeds, the printerTy and printerResultTy must be the same (there are no curried arguments)
UnifyTypes cenv env m printerTy printerResultTy
Expand Down
2 changes: 1 addition & 1 deletion src/Compiler/Checking/InfoReader.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1082,7 +1082,7 @@ let TryDestStandardDelegateType (infoReader: InfoReader) m ad delTy =
let g = infoReader.g
let (SigOfFunctionForDelegate(_, delArgTys, delRetTy, _)) = GetSigOfFunctionForDelegate infoReader delTy m ad
match delArgTys with
| senderTy :: argTys when (isObjTy g senderTy) && not (List.exists (isByrefTy g) argTys) -> Some(mkRefTupledTy g argTys, delRetTy)
| senderTy :: argTys when (isObjTyAnyNullness g senderTy) && not (List.exists (isByrefTy g) argTys) -> Some(mkRefTupledTy g argTys, delRetTy)
| _ -> None


Expand Down
2 changes: 1 addition & 1 deletion src/Compiler/Checking/MethodCalls.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1319,7 +1319,7 @@ let BuildNewDelegateExpr (eventInfoOpt: EventInfo option, g, amap, delegateTy, d
| Some einfo ->
match delArgVals with
| [] -> error(nonStandardEventError einfo.EventName m)
| h :: _ when not (isObjTy g h.Type) -> error(nonStandardEventError einfo.EventName m)
| h :: _ when not (isObjTyAnyNullness g h.Type) -> error(nonStandardEventError einfo.EventName m)
| h :: t -> [exprForVal m h; mkRefTupledVars g m t]
| None ->
if isNil delArgTys then [mkUnit g m] else List.map (exprForVal m) delArgVals
Expand Down
16 changes: 8 additions & 8 deletions src/Compiler/Checking/NameResolution.fs
Original file line number Diff line number Diff line change
Expand Up @@ -4422,14 +4422,14 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso
//
// Don't show GetHashCode or Equals for F# types that admit equality as an abnormal operation
let isUnseenDueToBasicObjRules =
not (isObjTy g ty) &&
not (isObjTyAnyNullness g ty) &&
not minfo.IsExtensionMember &&
match minfo.LogicalName with
| "GetType" -> false
| "GetHashCode" -> isObjTy g minfo.ApparentEnclosingType && not (AugmentTypeDefinitions.TypeDefinitelyHasEquality g ty)
| "GetHashCode" -> isObjTyAnyNullness g minfo.ApparentEnclosingType && not (AugmentTypeDefinitions.TypeDefinitelyHasEquality g ty)
| "ToString" -> false
| "Equals" ->
if not (isObjTy g minfo.ApparentEnclosingType) then
if not (isObjTyAnyNullness g minfo.ApparentEnclosingType) then
// declaring type is not System.Object - show it
false
elif minfo.IsInstance then
Expand All @@ -4440,7 +4440,7 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso
true
| _ ->
// filter out self methods of obj type
isObjTy g minfo.ApparentEnclosingType
isObjTyAnyNullness g minfo.ApparentEnclosingType

let result =
not isUnseenDueToBasicObjRules &&
Expand Down Expand Up @@ -5121,14 +5121,14 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty (
//
// Don't show GetHashCode or Equals for F# types that admit equality as an abnormal operation
let isUnseenDueToBasicObjRules =
not (isObjTy g ty) &&
not (isObjTyAnyNullness g ty) &&
not minfo.IsExtensionMember &&
match minfo.LogicalName with
| "GetType" -> false
| "GetHashCode" -> isObjTy g minfo.ApparentEnclosingType && not (AugmentTypeDefinitions.TypeDefinitelyHasEquality g ty)
| "GetHashCode" -> isObjTyAnyNullness g minfo.ApparentEnclosingType && not (AugmentTypeDefinitions.TypeDefinitelyHasEquality g ty)
| "ToString" -> false
| "Equals" ->
if not (isObjTy g minfo.ApparentEnclosingType) then
if not (isObjTyAnyNullness g minfo.ApparentEnclosingType) then
// declaring type is not System.Object - show it
false
elif minfo.IsInstance then
Expand All @@ -5139,7 +5139,7 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty (
true
| _ ->
// filter out self methods of obj type
isObjTy g minfo.ApparentEnclosingType
isObjTyAnyNullness g minfo.ApparentEnclosingType
let result =
not isUnseenDueToBasicObjRules &&
not minfo.IsInstance = statics &&
Expand Down
2 changes: 1 addition & 1 deletion src/Compiler/Checking/NicePrint.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2191,7 +2191,7 @@ module TastDefinitionPrinting =
let inherits =
[ if not (suppressInheritanceAndInterfacesForTyInSimplifiedDisplays g amap m ty) then
match GetSuperTypeOfType g amap m ty with
| Some superTy when not (isObjTy g superTy) && not (isValueTypeTy g superTy) ->
| Some superTy when not (isObjTyAnyNullness g superTy) && not (isValueTypeTy g superTy) ->
superTy
| _ -> ()
]
Expand Down
2 changes: 1 addition & 1 deletion src/Compiler/Checking/TypeHierarchy.fs
Original file line number Diff line number Diff line change
Expand Up @@ -67,7 +67,7 @@ let GetSuperTypeOfType g amap m 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
elif isRefTy g ty && not (isObjTyAnyNullness g ty) then
Some g.obj_ty_noNulls
elif isStructTupleTy g ty then
Some g.system_Value_ty
Expand Down
2 changes: 1 addition & 1 deletion src/Compiler/Checking/TypeRelations.fs
Original file line number Diff line number Diff line change
Expand Up @@ -117,7 +117,7 @@ let rec TypeFeasiblySubsumesType ndeep g amap m ty1 canCoerce ty2 =

| _ ->
// F# reference types are subtypes of type 'obj'
(isObjTy g ty1 && (canCoerce = CanCoerce || isRefTy g ty2))
(isObjTyAnyNullness g ty1 && (canCoerce = CanCoerce || isRefTy g ty2))
||
(isAppTy g ty2 &&
(canCoerce = CanCoerce || isRefTy g ty2) &&
Expand Down
10 changes: 6 additions & 4 deletions src/Compiler/Checking/infos.fs
Original file line number Diff line number Diff line change
Expand Up @@ -207,7 +207,7 @@ type OptionalArgInfo =
if isByrefTy g ty then
let ty = destByrefTy g ty
PassByRef (ty, analyze ty)
elif isObjTy g ty then
elif isObjTyAnyNullness g ty then
match ilParam.Marshal with
| Some(ILNativeType.IUnknown | ILNativeType.IDispatch | ILNativeType.Interface) -> Constant ILFieldInit.Null
| _ ->
Expand Down Expand Up @@ -296,7 +296,7 @@ let CrackParamAttribsInfo g (ty: TType, argInfo: ArgReprInfo) =
| None ->
// Do a type-directed analysis of the type to determine the default value to pass.
// Similar rules as OptionalArgInfo.FromILParameter are applied here, except for the COM and byref-related stuff.
CallerSide (if isObjTy g ty then MissingValue else DefaultValue)
CallerSide (if isObjTyAnyNullness g ty then MissingValue else DefaultValue)
| Some attr ->
let defaultValue = OptionalArgInfo.ValueOfDefaultParameterValueAttrib attr
match defaultValue with
Expand Down Expand Up @@ -364,7 +364,9 @@ type ILFieldInit with
| :? uint32 as i -> ILFieldInit.UInt32 i
| :? int64 as i -> ILFieldInit.Int64 i
| :? uint64 as i -> ILFieldInit.UInt64 i
| _ -> error(Error(FSComp.SR.infosInvalidProvidedLiteralValue(try !!v.ToString() with _ -> "?"), m))
| _ ->
let txt = match v with | null -> "?" | v -> try !!v.ToString() with _ -> "?"
error(Error(FSComp.SR.infosInvalidProvidedLiteralValue(txt), m))


/// Compute the OptionalArgInfo for a provided parameter.
Expand All @@ -382,7 +384,7 @@ let OptionalArgInfoOfProvidedParameter (amap: ImportMap) m (provParam : Tainted<
if isByrefTy g ty then
let ty = destByrefTy g ty
PassByRef (ty, analyze ty)
elif isObjTy g ty then MissingValue
elif isObjTyAnyNullness g ty then MissingValue
else DefaultValue

let paramTy = ImportProvidedType amap m (provParam.PApply((fun p -> p.ParameterType), m))
Expand Down
6 changes: 3 additions & 3 deletions src/Compiler/CodeGen/IlxGen.fs
Original file line number Diff line number Diff line change
Expand Up @@ -3782,11 +3782,11 @@ and GenCoerce cenv cgbuf eenv (e, tgtTy, m, srcTy) sequel =
else
GenExpr cenv cgbuf eenv e Continue

if not (isObjTy g srcTy) then
if not (isObjTyAnyNullness g srcTy) then
let ilFromTy = GenType cenv m eenv.tyenv srcTy
CG.EmitInstr cgbuf (pop 1) (Push [ g.ilg.typ_Object ]) (I_box ilFromTy)

if not (isObjTy g tgtTy) then
if not (isObjTyAnyNullness g tgtTy) then
let ilToTy = GenType cenv m eenv.tyenv tgtTy
CG.EmitInstr cgbuf (pop 1) (Push [ ilToTy ]) (I_unbox_any ilToTy)

Expand Down Expand Up @@ -12118,7 +12118,7 @@ let LookupGeneratedValue (cenv: cenv) (ctxt: ExecutionContext) eenv (v: Val) =
None

// Invoke the set_Foo method for a declaration with a value. Used to create variables with values programmatically in fsi.exe.
let SetGeneratedValue (ctxt: ExecutionContext) eenv isForced (v: Val) (value: obj) =
let SetGeneratedValue (ctxt: ExecutionContext) eenv isForced (v: Val) (value: objnull) =
try
match StorageForVal v.Range v eenv with
| StaticPropertyWithField(fspec, _, hasLiteralAttr, _, _, _, _f, ilSetterMethRef, _) ->
Expand Down
28 changes: 14 additions & 14 deletions src/Compiler/DependencyManager/DependencyProvider.fs
Original file line number Diff line number Diff line change
Expand Up @@ -160,19 +160,19 @@ type ReflectionDependencyManagerProvider

let instance =
if not (isNull (theType.GetConstructor([| typeof<string option>; typeof<bool> |]))) then
Activator.CreateInstance(theType, [| outputDir :> obj; useResultsCache :> obj |])
Activator.CreateInstance(theType, [| outputDir :> objnull; useResultsCache :> objnull |])
else
Activator.CreateInstance(theType, [| outputDir :> obj |])
Activator.CreateInstance(theType, [| outputDir :> objnull |])

let nameProperty = nameProperty.GetValue >> string
let keyProperty = keyProperty.GetValue >> string
let nameProperty (x: objnull) = x |> nameProperty.GetValue |> string
let keyProperty (x: objnull) = x |> keyProperty.GetValue |> string

let helpMessagesProperty =
let toStringArray (o: obj) = o :?> string[]
let helpMessagesProperty (x: objnull) =
let toStringArray (o: objnull) = o :?> string[]

match helpMessagesProperty with
| Some helpMessagesProperty -> helpMessagesProperty.GetValue >> toStringArray
| None -> fun _ -> [||]
| Some helpMessagesProperty -> x |> helpMessagesProperty.GetValue |> toStringArray
| None -> [||]

static member InstanceMaker(theType: Type, outputDir: string option, useResultsCache: bool) =
match
Expand Down Expand Up @@ -453,14 +453,18 @@ type ReflectionDependencyManagerProvider
None, [||]

match method with
| None -> ReflectionDependencyManagerProvider.MakeResultFromFields(false, [||], [||], Seq.empty, Seq.empty, Seq.empty)
| Some m ->
let result = m.Invoke(instance, arguments)
match m.Invoke(instance, arguments) with
| null -> ReflectionDependencyManagerProvider.MakeResultFromFields(false, [||], [||], Seq.empty, Seq.empty, Seq.empty)

// Verify the number of arguments returned in the tuple returned by resolvedependencies, it can be:
// 1 - object with properties
// 3 - (bool * string list * string list)
// Support legacy api return shape (bool, seq<string>, seq<string>) --- original paket packagemanager
if FSharpType.IsTuple(result.GetType()) then
| result when FSharpType.IsTuple(result.GetType()) |> not ->
ReflectionDependencyManagerProvider.MakeResultFromObject(result)
| result ->
// Verify the number of arguments returned in the tuple returned by resolvedependencies, it can be:
// 3 - (bool * string list * string list)
let success, sourceFiles, packageRoots =
Expand All @@ -474,10 +478,6 @@ type ReflectionDependencyManagerProvider
| _ -> false, seqEmpty, seqEmpty

ReflectionDependencyManagerProvider.MakeResultFromFields(success, [||], [||], Seq.empty, sourceFiles, packageRoots)
else
ReflectionDependencyManagerProvider.MakeResultFromObject(result)

| None -> ReflectionDependencyManagerProvider.MakeResultFromFields(false, [||], [||], Seq.empty, Seq.empty, Seq.empty)

/// Provides DependencyManagement functions.
/// Class is IDisposable
Expand Down
2 changes: 1 addition & 1 deletion src/Compiler/Driver/GraphChecking/Graph.fs
Original file line number Diff line number Diff line change
Expand Up @@ -83,7 +83,7 @@ module internal Graph =
graph
|> Seq.iter (fun (KeyValue(file, deps)) -> printfn $"{file} -> {deps |> Array.map nodePrinter |> join}")

let print (graph: Graph<'Node>) : unit =
let print (graph: Graph<'Node> when 'Node: not null) : unit =
printCustom graph (fun node -> node.ToString() |> string)

let serialiseToMermaid (graph: Graph<FileIndex * string>) =
Expand Down
2 changes: 1 addition & 1 deletion src/Compiler/Driver/GraphChecking/Graph.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@ module internal Graph =
/// Create a reverse of the graph.
val reverse<'Node when 'Node: equality> : originalGraph: Graph<'Node> -> Graph<'Node>
/// Print the contents of the graph to the standard output.
val print: graph: Graph<'Node> -> unit
val print: graph: Graph<'Node> -> unit when 'Node: not null
/// Create a simple Mermaid graph
val serialiseToMermaid: graph: Graph<FileIndex * string> -> string
/// Create a simple Mermaid graph and save it under the path specified.
Expand Down
8 changes: 4 additions & 4 deletions src/Compiler/Facilities/prim-parsing.fs
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@ exception Accept of obj

[<Sealed>]
type internal IParseState
(ruleStartPoss: Position[], ruleEndPoss: Position[], lhsPos: Position[], ruleValues: obj[], lexbuf: LexBuffer<char>) =
(ruleStartPoss: Position[], ruleEndPoss: Position[], lhsPos: Position[], ruleValues: objnull[], lexbuf: LexBuffer<char>) =
member _.LexBuffer = lexbuf

member _.InputRange index =
Expand Down Expand Up @@ -125,7 +125,7 @@ type Stack<'a>(n) =

member buf.PrintStack() =
for i = 0 to (count - 1) do
Console.Write("{0}{1}", contents[i], (if i = count - 1 then ":" else "-"))
Console.Write("{0}{1}", contents[i] :> objnull, (if i = count - 1 then ":" else "-"))

module Flags =
#if DEBUG
Expand Down Expand Up @@ -231,7 +231,7 @@ module internal Implementation =
[<NoEquality; NoComparison>]
[<Struct>]
type ValueInfo =
val value: obj
val value: objnull
val startPos: Position
val endPos: Position

Expand Down Expand Up @@ -269,7 +269,7 @@ module internal Implementation =
// The 100 here means a maximum of 100 elements for each rule
let ruleStartPoss = (Array.zeroCreate 100: Position[])
let ruleEndPoss = (Array.zeroCreate 100: Position[])
let ruleValues = (Array.zeroCreate 100: obj[])
let ruleValues = (Array.zeroCreate 100: objnull[])
let lhsPos = (Array.zeroCreate 2: Position[])
let reductions = tables.reductions
let cacheSize = 7919 // the 1000'th prime
Expand Down
Loading
Loading