Skip to content
Draft
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
6 changes: 6 additions & 0 deletions docs/release-notes/.FSharp.Compiler.Service/10.0.300.md
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,12 @@
* Fix FS3356 false positive for instance extension members with same name on different types, introduced by [#18821](https://github.com/dotnet/fsharp/pull/18821). ([PR #19260](https://github.com/dotnet/fsharp/pull/19260))
* Fix graph-based type checking incorrectly resolving dependencies when the same module name is defined across multiple files in the same namespace. ([PR #19280](https://github.com/dotnet/fsharp/pull/19280))
* F# Scripts: Fix default reference paths resolving when an SDK directory is specified. ([PR #19270](https://github.com/dotnet/fsharp/pull/19270))
* Fix TypeLoadException when creating delegate with voidptr parameter. (Issue [#11132](https://github.com/dotnet/fsharp/issues/11132), [PR #19338](https://github.com/dotnet/fsharp/pull/19338))
* Suppress tail calls when localloc (NativePtr.stackalloc) is used. (Issue [#13447](https://github.com/dotnet/fsharp/issues/13447), [PR #19338](https://github.com/dotnet/fsharp/pull/19338))
* Fix TypeLoadException in Release builds with inline constraints. (Issue [#14492](https://github.com/dotnet/fsharp/issues/14492), [PR #19338](https://github.com/dotnet/fsharp/pull/19338))
* Fix nativeptr in interfaces leads to TypeLoadException. (Issue [#14508](https://github.com/dotnet/fsharp/issues/14508), [PR #19338](https://github.com/dotnet/fsharp/pull/19338))
* Fix box instruction for literal upcasts. (Issue [#18319](https://github.com/dotnet/fsharp/issues/18319), [PR #19338](https://github.com/dotnet/fsharp/pull/19338))
* Fix Decimal Literal causes InvalidProgramException in Debug builds. (Issue [#18956](https://github.com/dotnet/fsharp/issues/18956), [PR #19338](https://github.com/dotnet/fsharp/pull/19338))

### Added
* FSharpType: add ImportILType ([PR #19300](https://github.com/dotnet/fsharp/pull/19300))
Expand Down
9 changes: 9 additions & 0 deletions src/Compiler/AbstractIL/il.fs
Original file line number Diff line number Diff line change
Expand Up @@ -3333,6 +3333,15 @@ let mkILSimpleTypar nm =
MetadataIndex = NoMetadataIdx
}

let stripILGenericParamConstraints (gp: ILGenericParameterDef) =
{ gp with
Constraints = []
HasReferenceTypeConstraint = false
HasNotNullableValueTypeConstraint = false
HasDefaultConstructorConstraint = false
HasAllowsRefStruct = false
}

let genericParamOfGenericActual (_ga: ILType) = mkILSimpleTypar "T"

let mkILFormalTypars (x: ILGenericArgsList) = List.map genericParamOfGenericActual x
Expand Down
1 change: 1 addition & 0 deletions src/Compiler/AbstractIL/il.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -2066,6 +2066,7 @@ val internal mkILFormalNamedTy: ILBoxity -> ILTypeRef -> ILGenericParameterDef l
val internal mkILFormalTypars: ILType list -> ILGenericParameterDefs
val internal mkILFormalGenericArgs: int -> ILGenericParameterDefs -> ILGenericArgsList
val internal mkILSimpleTypar: string -> ILGenericParameterDef
val internal stripILGenericParamConstraints: ILGenericParameterDef -> ILGenericParameterDef

/// Make custom attributes.
val internal mkILCustomAttribMethRef:
Expand Down
36 changes: 32 additions & 4 deletions src/Compiler/CodeGen/EraseClosures.fs
Original file line number Diff line number Diff line change
Expand Up @@ -152,7 +152,19 @@ let newIlxPubCloEnv (ilg, addMethodGeneratedAttrs, addFieldGeneratedAttrs, addFi

let mkILTyFuncTy cenv = cenv.mkILTyFuncTy

let inline private (|IsVoidPtr|_|) ty =
match ty with
| ILType.Ptr ILType.Void -> true
| _ -> false

let private fixVoidPtrForGenericArg (ilg: ILGlobals) ty =
match ty with
| IsVoidPtr -> ilg.typ_IntPtr
| _ -> ty

let mkILFuncTy cenv dty rty =
let dty = fixVoidPtrForGenericArg cenv.ilg dty
let rty = fixVoidPtrForGenericArg cenv.ilg rty
mkILBoxedTy cenv.tref_Func[0] [ dty; rty ]

let mkILCurriedFuncTy cenv dtys rty =
Expand All @@ -167,6 +179,8 @@ let typ_Func cenv (dtys: ILType list) rty =
else
mkFuncTypeRef cenv.ilg.fsharpCoreAssemblyScopeRef n

let dtys = dtys |> List.map (fixVoidPtrForGenericArg cenv.ilg)
let rty = fixVoidPtrForGenericArg cenv.ilg rty
mkILBoxedTy tref (dtys @ [ rty ])

let rec mkTyOfApps cenv apps =
Expand All @@ -189,6 +203,8 @@ let mkMethSpecForMultiApp cenv (argTys: ILType list, retTy) =
let n = argTys.Length
let formalArgTys = List.mapi (fun i _ -> ILType.TypeVar(uint16 i)) argTys
let formalRetTy = ILType.TypeVar(uint16 n)
let argTys = argTys |> List.map (fixVoidPtrForGenericArg cenv.ilg)
let retTy = fixVoidPtrForGenericArg cenv.ilg retTy
let inst = argTys @ [ retTy ]

if n = 1 then
Expand Down Expand Up @@ -545,12 +561,14 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo =

let convil = convILMethodBody (Some nowCloSpec, boxReturnTy) clo.cloCode.Value

let specializeGenParams = addedGenParams |> List.map stripILGenericParamConstraints

let nowApplyMethDef =
mkILGenericVirtualMethod (
"Specialize",
ILCallingConv.Instance,
ILMemberAccess.Public,
addedGenParams (* method is generic over added ILGenericParameterDefs *) ,
specializeGenParams,
[],
mkILReturn cenv.ilg.typ_Object,
MethodBody.IL(notlazy convil)
Expand Down Expand Up @@ -676,7 +694,17 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo =
else
// CASE 2b - Build an Invoke method

let nowEnvParentClass = typ_Func cenv (typesOfILParams nowParams) nowReturnTy
let fixedNowParams =
nowParams
|> List.map (fun (p: ILParameter) ->
{ p with
Type = fixVoidPtrForGenericArg cenv.ilg p.Type
})

let fixedNowReturnTy = fixVoidPtrForGenericArg cenv.ilg nowReturnTy

let nowEnvParentClass =
typ_Func cenv (typesOfILParams fixedNowParams) fixedNowReturnTy

let cloTypeDef =
let convil = convILMethodBody (Some nowCloSpec, None) clo.cloCode.Value
Expand All @@ -685,8 +713,8 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo =
mkILNonGenericVirtualInstanceMethod (
"Invoke",
ILMemberAccess.Public,
nowParams,
mkILReturn nowReturnTy,
fixedNowParams,
mkILReturn fixedNowReturnTy,
MethodBody.IL(notlazy convil)
)

Expand Down
159 changes: 136 additions & 23 deletions src/Compiler/CodeGen/IlxGen.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1394,6 +1394,28 @@ let TryStorageForWitness (_g: TcGlobals) eenv (w: TraitWitnessInfo) =
let IsValRefIsDllImport g (vref: ValRef) =
vref.Attribs |> HasFSharpAttributeOpt g g.attrib_DllImportAttribute

/// Check if a type contains nativeptr with a type parameter from the given set.
/// Used to detect interface implementations that need 'native int' return type.
let hasNativePtrWithTypar (g: TcGlobals) (typars: Typar list) ty =
let rec check ty =
let ty = stripTyEqns g ty

match ty with
| TType_app(tcref, tinst, _) when tyconRefEq g g.nativeptr_tcr tcref ->
tinst
|> List.exists (fun t ->
match stripTyEqns g t with
| TType_var(tp, _) -> typars |> List.exists (fun tp2 -> tp.Stamp = tp2.Stamp)
| _ -> false)
| TType_app(_, tinst, _) -> tinst |> List.exists check
| TType_fun(d, r, _) -> check d || check r
| TType_tuple(_, tys) -> tys |> List.exists check
| TType_anon(_, tys) -> tys |> List.exists check
| TType_forall(_, t) -> check t
| _ -> false

check ty

/// Determine how a top level value is represented, when it is being represented
/// as a method.
let GetMethodSpecForMemberVal cenv (memberInfo: ValMemberInfo) (vref: ValRef) =
Expand Down Expand Up @@ -1421,7 +1443,34 @@ let GetMethodSpecForMemberVal cenv (memberInfo: ValMemberInfo) (vref: ValRef) =

let ilActualRetTy =
let ilRetTy = GenReturnType cenv m tyenvUnderTypars returnTy
if isCtor || cctor then ILType.Void else ilRetTy

if isCtor || cctor then
ILType.Void
// When implementing an interface slot with nativeptr<'T> where 'T is an interface
// type parameter and the interface type args are concrete, the interface method
// returns 'native int'. The method def must also return 'native int' to match.
elif memberInfo.MemberFlags.IsOverrideOrExplicitImpl then
match
memberInfo.ImplementedSlotSigs
|> List.tryPick (fun (TSlotSig(_, ty, sctps, _, _, sRetTy)) ->
let interfaceTypeArgs = argsOfAppTy g ty

if
not sctps.IsEmpty
&& (freeInTypes CollectTypars interfaceTypeArgs).FreeTypars.IsEmpty
&& sRetTy |> Option.exists (hasNativePtrWithTypar g sctps)
then
Some(sctps, sRetTy)
else
None)
with
| Some(sctps, sRetTy) ->
// Generate return type using the slot's type params so nativeptr<'T> → native int
let slotEnv = TypeReprEnv.Empty.ForTypars sctps
GenReturnType cenv m slotEnv sRetTy
| None -> ilRetTy
else
ilRetTy

let ilTy =
GenType cenv m tyenvUnderTypars (mkWoNullAppTy parentTcref (List.map mkTyparTy ctps))
Expand Down Expand Up @@ -2508,6 +2557,8 @@ type CodeGenBuffer(m: range, mgbuf: AssemblyBuilder, methodName, alreadyUsedArgs
let mutable hasDebugPoints = false
let mutable anyDocument = None // we collect an arbitrary document in order to emit the header FeeFee if needed

let mutable hasStackAllocatedLocals = false

let codeLabelToPC: Dictionary<ILCodeLabel, int> = Dictionary<_, _>(10)

let codeLabelToCodeLabel: Dictionary<ILCodeLabel, ILCodeLabel> =
Expand Down Expand Up @@ -2566,11 +2617,19 @@ type CodeGenBuffer(m: range, mgbuf: AssemblyBuilder, methodName, alreadyUsedArgs
member cgbuf.EmitInstr(pops, pushes, i) =
cgbuf.DoPops pops
cgbuf.DoPushes pushes

if i = I_localloc then
hasStackAllocatedLocals <- true

codebuf.Add i

member cgbuf.EmitInstrs(pops, pushes, is) =
cgbuf.DoPops pops
cgbuf.DoPushes pushes

if is |> List.exists (fun i -> i = I_localloc) then
hasStackAllocatedLocals <- true

is |> List.iter codebuf.Add

member private _.EnsureNopBetweenDebugPoints() =
Expand Down Expand Up @@ -2703,6 +2762,8 @@ type CodeGenBuffer(m: range, mgbuf: AssemblyBuilder, methodName, alreadyUsedArgs
member _.HasPinnedLocals() =
locals |> Seq.exists (fun (_, _, isFixed, _) -> isFixed)

member _.HasStackAllocatedLocals() = hasStackAllocatedLocals

member _.Close() =

let instrs = codebuf.ToArray()
Expand Down Expand Up @@ -3320,32 +3381,50 @@ and GenConstant cenv cgbuf eenv (c, m, ty) sequel =
match TryEliminateDesugaredConstants g m c with
| Some e -> GenExpr cenv cgbuf eenv e Continue
| None ->
let emitInt64Constant i =
let needsBoxingToTargetTy =
(match ilTy with
| ILType.Value _ -> false
| _ -> true)

// Wraps an emitter: calls it, then boxes if target type is not a value type (e.g. literal upcast to obj).
let inline emitAndBoxIfNeeded emitter uty arg =
emitter uty arg

if needsBoxingToTargetTy then
CG.EmitInstr cgbuf (pop 1) (Push [ ilTy ]) (I_box uty)

let emitInt64Constant uty i =
// see https://github.com/dotnet/fsharp/pull/3620
// and https://github.com/dotnet/fsharp/issue/8683
// and https://github.com/dotnet/roslyn/blob/98f12bb/src/Compilers/Core/Portable/CodeGen/ILBuilderEmit.cs#L679
if i >= int64 Int32.MinValue && i <= int64 Int32.MaxValue then
CG.EmitInstrs cgbuf (pop 0) (Push [ ilTy ]) [ mkLdcInt32 (int32 i); AI_conv DT_I8 ]
CG.EmitInstrs cgbuf (pop 0) (Push [ uty ]) [ mkLdcInt32 (int32 i); AI_conv DT_I8 ]
elif i >= int64 UInt32.MinValue && i <= int64 UInt32.MaxValue then
CG.EmitInstrs cgbuf (pop 0) (Push [ ilTy ]) [ mkLdcInt32 (int32 i); AI_conv DT_U8 ]
CG.EmitInstrs cgbuf (pop 0) (Push [ uty ]) [ mkLdcInt32 (int32 i); AI_conv DT_U8 ]
else
CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (iLdcInt64 i)
CG.EmitInstr cgbuf (pop 0) (Push [ uty ]) (iLdcInt64 i)

let emitConst uty instr =
CG.EmitInstr cgbuf (pop 0) (Push [ uty ]) instr

let emitConstI uty instrs =
CG.EmitInstrs cgbuf (pop 0) (Push [ uty ]) instrs

match c with
| Const.Bool b -> CG.EmitInstr cgbuf (pop 0) (Push [ g.ilg.typ_Bool ]) (mkLdcInt32 (if b then 1 else 0))
| Const.SByte i -> CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (mkLdcInt32 (int32 i))
| Const.Int16 i -> CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (mkLdcInt32 (int32 i))
| Const.Int32 i -> CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (mkLdcInt32 i)
| Const.Int64 i -> emitInt64Constant i
| Const.IntPtr i -> CG.EmitInstrs cgbuf (pop 0) (Push [ ilTy ]) [ iLdcInt64 i; AI_conv DT_I ]
| Const.Byte i -> CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (mkLdcInt32 (int32 i))
| Const.UInt16 i -> CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (mkLdcInt32 (int32 i))
| Const.UInt32 i -> CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (mkLdcInt32 (int32 i))
| Const.UInt64 i -> emitInt64Constant (int64 i)
| Const.UIntPtr i -> CG.EmitInstrs cgbuf (pop 0) (Push [ ilTy ]) [ iLdcInt64 (int64 i); AI_conv DT_U ]
| Const.Double f -> CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (AI_ldc(DT_R8, ILConst.R8 f))
| Const.Single f -> CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (AI_ldc(DT_R4, ILConst.R4 f))
| Const.Char c -> CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (mkLdcInt32 (int c))
| Const.Bool b -> emitAndBoxIfNeeded emitConst g.ilg.typ_Bool (mkLdcInt32 (if b then 1 else 0))
| Const.SByte i -> emitAndBoxIfNeeded emitConst g.ilg.typ_SByte (mkLdcInt32 (int32 i))
| Const.Int16 i -> emitAndBoxIfNeeded emitConst g.ilg.typ_Int16 (mkLdcInt32 (int32 i))
| Const.Int32 i -> emitAndBoxIfNeeded emitConst g.ilg.typ_Int32 (mkLdcInt32 i)
| Const.Int64 i -> emitAndBoxIfNeeded emitInt64Constant g.ilg.typ_Int64 i
| Const.IntPtr i -> emitAndBoxIfNeeded emitConstI g.ilg.typ_IntPtr [ iLdcInt64 i; AI_conv DT_I ]
| Const.Byte i -> emitAndBoxIfNeeded emitConst g.ilg.typ_Byte (mkLdcInt32 (int32 i))
| Const.UInt16 i -> emitAndBoxIfNeeded emitConst g.ilg.typ_UInt16 (mkLdcInt32 (int32 i))
| Const.UInt32 i -> emitAndBoxIfNeeded emitConst g.ilg.typ_UInt32 (mkLdcInt32 (int32 i))
| Const.UInt64 i -> emitAndBoxIfNeeded emitInt64Constant g.ilg.typ_UInt64 (int64 i)
| Const.UIntPtr i -> emitAndBoxIfNeeded emitConstI g.ilg.typ_UIntPtr [ iLdcInt64 (int64 i); AI_conv DT_U ]
| Const.Double f -> emitAndBoxIfNeeded emitConst g.ilg.typ_Double (AI_ldc(DT_R8, ILConst.R8 f))
| Const.Single f -> emitAndBoxIfNeeded emitConst g.ilg.typ_Single (AI_ldc(DT_R4, ILConst.R4 f))
| Const.Char c -> emitAndBoxIfNeeded emitConst g.ilg.typ_Char (mkLdcInt32 (int c))
| Const.String s -> GenString cenv cgbuf s
| Const.Unit -> GenUnit cenv eenv m cgbuf
| Const.Zero -> GenDefaultValue cenv cgbuf eenv (ty, m)
Expand Down Expand Up @@ -4509,6 +4588,7 @@ and CanTailcall
// Can't tailcall with a .NET 2.0 generic constrained call since it involves a byref
// Can't tailcall when there are pinned locals since the stack frame must remain alive
let hasPinnedLocals = cgbuf.HasPinnedLocals()
let hasStackAllocatedLocals = cgbuf.HasStackAllocatedLocals()

if
not hasStructObjArg
Expand All @@ -4519,6 +4599,7 @@ and CanTailcall
&& not isSelfInit
&& not makesNoCriticalTailcalls
&& not hasPinnedLocals
&& not hasStackAllocatedLocals
&&

// We can tailcall even if we need to generate "unit", as long as we're about to throw the value away anyway as par of the return.
Expand Down Expand Up @@ -5840,6 +5921,8 @@ and GenFormalReturnType m cenv eenvFormal returnTy : ILReturn =
and instSlotParam inst (TSlotParam(nm, ty, inFlag, fl2, fl3, attrs)) =
TSlotParam(nm, instType inst ty, inFlag, fl2, fl3, attrs)

and containsNativePtrWithTypar (g: TcGlobals) (typars: Typar list) ty = hasNativePtrWithTypar g typars ty

and GenActualSlotsig
m
cenv
Expand All @@ -5848,14 +5931,44 @@ and GenActualSlotsig
methTyparsOfOverridingMethod
(methodParams: Val list)
=
let g = cenv.g
let ilSlotParams = List.concat ilSlotParams

let interfaceTypeArgs = argsOfAppTy g ty

let instForSlotSig =
mkTyparInst (ctps @ mtps) (argsOfAppTy cenv.g ty @ generalizeTypars methTyparsOfOverridingMethod)
mkTyparInst (ctps @ mtps) (interfaceTypeArgs @ generalizeTypars methTyparsOfOverridingMethod)

let interfaceTypeArgsAreConcrete =
not ctps.IsEmpty
&& (freeInTypes CollectTypars interfaceTypeArgs).FreeTypars.IsEmpty

let slotHasNativePtrWithCtps =
interfaceTypeArgsAreConcrete
&& (ilSlotParams
|> List.exists (fun (TSlotParam(_, ty, _, _, _, _)) -> containsNativePtrWithTypar g ctps ty)
|| ilSlotRetTy |> Option.exists (containsNativePtrWithTypar g ctps))

let eenvForSlotGen =
if slotHasNativePtrWithCtps then
EnvForTypars ctps eenv
else
eenv

// When the slot has nativeptr with concrete interface type args, don't substitute
// the class type params (ctps) - only substitute method type params (mtps).
// This keeps nativeptr<'T> unsubstituted so it generates 'native int' in IL,
// matching the interface method's signature. Without this, nativeptr<'T> would be
// substituted to nativeptr<concrete> which generates 'T*', causing a TypeLoadException.
let instForSlotSigGen =
if slotHasNativePtrWithCtps then
mkTyparInst mtps (generalizeTypars methTyparsOfOverridingMethod)
else
instForSlotSig

let ilParams =
ilSlotParams
|> List.map (instSlotParam instForSlotSig >> GenSlotParam m cenv eenv)
|> List.map (instSlotParam instForSlotSigGen >> GenSlotParam m cenv eenvForSlotGen)

// Use the better names if available
let ilParams =
Expand All @@ -5866,15 +5979,15 @@ and GenActualSlotsig
ilParams

let ilRetTy =
GenReturnType cenv m eenv.tyenv (Option.map (instType instForSlotSig) ilSlotRetTy)
GenReturnType cenv m eenvForSlotGen.tyenv (Option.map (instType instForSlotSigGen) ilSlotRetTy)

let iLRet = mkILReturn ilRetTy

let ilRetWithAttrs =
match ilSlotRetTy with
| None -> iLRet
| Some t ->
match GenAdditionalAttributesForTy cenv.g t with
match GenAdditionalAttributesForTy g t with
| [] -> iLRet
| attrs -> iLRet.WithCustomAttrs(mkILCustomAttrs attrs)

Expand Down
Loading
Loading