diff --git a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md index d5c2087765e..7f91810e098 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md @@ -22,3 +22,4 @@ * Added warning FS3884 when a function or delegate value is used as an interpolated string argument. ([PR #19289](https://github.com/dotnet/fsharp/pull/19289)) * Add `#version;;` directive to F# Interactive to display version and environment information. ([Issue #13307](https://github.com/dotnet/fsharp/issues/13307), [PR #19332](https://github.com/dotnet/fsharp/pull/19332)) +* Optimizer: don't inline named functions in debug builds ([PR #19548](https://github.com/dotnet/fsharp/pull/19548) \ No newline at end of file diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index 0fbe48fb2eb..6075a7a32a7 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -600,6 +600,8 @@ type TcConfigBuilder = mutable strictIndentation: bool option + mutable inlineNamedFunctions: bool option + mutable exename: string option // If true - the compiler will copy FSharp.Core.dll along the produced binaries @@ -853,6 +855,7 @@ type TcConfigBuilder = dumpSignatureData = false realsig = false strictIndentation = None + inlineNamedFunctions = None compilationMode = TcGlobals.CompilationMode.Unset } @@ -1253,6 +1256,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.fsiMultiAssemblyEmit = data.fsiMultiAssemblyEmit member _.FxResolver = data.FxResolver member _.strictIndentation = data.strictIndentation + member _.inlineNamedFunctions = data.inlineNamedFunctions member _.primaryAssembly = data.primaryAssembly member _.noFeedback = data.noFeedback member _.stackReserveSize = data.stackReserveSize diff --git a/src/Compiler/Driver/CompilerConfig.fsi b/src/Compiler/Driver/CompilerConfig.fsi index 17e035109ab..85ce24133a6 100644 --- a/src/Compiler/Driver/CompilerConfig.fsi +++ b/src/Compiler/Driver/CompilerConfig.fsi @@ -472,6 +472,8 @@ type TcConfigBuilder = mutable strictIndentation: bool option + mutable inlineNamedFunctions: bool option + mutable exename: string option mutable copyFSharpCore: CopyFSharpCoreFlag @@ -814,6 +816,8 @@ type TcConfig = member strictIndentation: bool option + member inlineNamedFunctions: bool option + member GetTargetFrameworkDirectories: unit -> string list /// Get the loaded sources that exist and issue a warning for the ones that don't diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index 98cec17265c..0ba0afb60ca 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -1207,6 +1207,14 @@ let languageFlags tcConfigB = None, Some(FSComp.SR.optsStrictIndentation (formatOptionSwitch (Option.defaultValue false tcConfigB.strictIndentation))) ) + + CompilerOption( + "inline-named-functions", + tagNone, + OptionSwitch(fun switch -> tcConfigB.inlineNamedFunctions <- Some(switch = OptionSwitch.On)), + None, + Some(FSComp.SR.optsInlineNamedFunctions ()) + ) ] // OptionBlock: Advanced user options diff --git a/src/Compiler/Driver/OptimizeInputs.fs b/src/Compiler/Driver/OptimizeInputs.fs index 78bca4bf979..cace428af4d 100644 --- a/src/Compiler/Driver/OptimizeInputs.fs +++ b/src/Compiler/Driver/OptimizeInputs.fs @@ -327,6 +327,9 @@ let ApplyAllOptimizations // Only do abstractBigTargets in the first phase, and only when TLR is on. abstractBigTargets = tcConfig.doTLR reportingPhase = true + inlineNamedFunctions = + tcConfig.inlineNamedFunctions + |> Option.defaultValue (not tcConfig.debuginfo || tcConfig.optSettings.LocalOptimizationsEnabled) } // Only do these two steps in the first phase. @@ -334,6 +337,7 @@ let ApplyAllOptimizations { firstLoopSettings with abstractBigTargets = false reportingPhase = false + inlineNamedFunctions = false } let addPhaseDiagnostics (f: PhaseFunc) (info: Phase) = diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index a4007147b9a..cc05986e2e6 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1560,6 +1560,7 @@ optsSetLangVersion,"Specify language version such as 'latest' or 'preview'." optsDisableLanguageFeature,"Disable a specific language feature by name." optsSupportedLangVersions,"Supported language versions:" optsStrictIndentation,"Override indentation rules implied by the language version (%s by default)" +optsInlineNamedFunctions,"Inline named 'inline' functions" nativeResourceFormatError,"Stream does not begin with a null resource and is not in '.RES' format." nativeResourceHeaderMalformed,"Resource header beginning at offset %s is malformed." formatDashItem," - %s" diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index 3cbb574598c..088d351ae39 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -23,6 +23,7 @@ open FSharp.Compiler.Text.LayoutRender open FSharp.Compiler.Text.TaggedText open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics +open FSharp.Compiler.Xml open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeOps.DebugPrint open FSharp.Compiler.TypedTreePickle @@ -327,6 +328,8 @@ type OptimizationSettings = reportTotalSizes : bool processingMode : OptimizationProcessingMode + + inlineNamedFunctions: bool } static member Defaults = @@ -344,6 +347,7 @@ type OptimizationSettings = reportHasEffect = false reportTotalSizes = false processingMode = OptimizationProcessingMode.Parallel + inlineNamedFunctions = false } /// Determines if JIT optimizations are enabled @@ -432,6 +436,8 @@ type cenv = stackGuard: StackGuard realsig: bool + + specializedInlineVals: HashMultiMap } override x.ToString() = "" @@ -500,8 +506,9 @@ let CheckInlineValueIsComplete (v: Val) res = errorR(Error(FSComp.SR.optValueMarkedInlineButIncomplete(v.DisplayName), v.Range)) //System.Diagnostics.Debug.Assert(false, sprintf "Break for incomplete inline value %s" v.DisplayName) -let check (vref: ValRef) (res: ValInfo) = - CheckInlineValueIsComplete vref.Deref res.ValExprInfo +let check (cenv: cenv) (vref: ValRef) (res: ValInfo) = + if cenv.settings.inlineNamedFunctions then + CheckInlineValueIsComplete vref.Deref res.ValExprInfo (vref, res) //------------------------------------------------------------------------- @@ -691,7 +698,7 @@ let GetInfoForVal cenv env m (vref: ValRef) = let GetInfoForValWithCheck cenv env m (vref: ValRef) = let res = GetInfoForVal cenv env m vref - check vref res |> ignore + check cenv vref res |> ignore res let IsPartialExpr cenv env m x = @@ -1325,7 +1332,7 @@ let CombineValueInfos einfos res = let CombineValueInfosUnknown einfos = CombineValueInfos einfos UnknownValue /// Hide information because of a signature -let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = +let AbstractLazyModulInfoByHiding isAssemblyBoundary (cenv: cenv) mhi = // The freevars and FreeTyvars can indicate if the non-public (hidden) items have been used. // Under those checks, the further hidden* checks may be subsumed (meaning, not required anymore). @@ -1353,6 +1360,7 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = // Check for escape in lambda | CurriedLambdaValue (_, _, _, expr, _) | ConstExprValue(_, expr) when + cenv.settings.inlineNamedFunctions && (let fvs = freeInExpr CollectAll expr (isAssemblyBoundary && not (freeVarsAllPublic fvs)) || Zset.exists hiddenVal fvs.FreeLocals || @@ -1399,8 +1407,9 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = { ModuleOrNamespaceInfos = NameMap.map abstractLazyModulInfo ss.ModuleOrNamespaceInfos ValInfos = ValInfos(ss.ValInfos.Entries - |> Seq.filter (fun (vref, _) -> not (hiddenVal vref.Deref)) - |> Seq.map (fun (vref, e) -> check (* "its implementation uses a binding hidden by a signature" m *) vref (abstractValInfo e) )) } + |> Seq.filter (fun (vref, _) -> + not (hiddenVal vref.Deref) || not cenv.settings.inlineNamedFunctions && vref.Deref.ShouldInline) + |> Seq.map (fun (vref, e) -> check cenv vref (abstractValInfo e) )) } and abstractLazyModulInfo (ss: LazyModuleInfo) = ss.Force() |> abstractModulInfo |> notlazy @@ -1419,7 +1428,7 @@ let AbstractOptimizationInfoToEssentials = abstractLazyModulInfo /// Hide information because of a "let ... in ..." or "let rec ... in ... " -let AbstractExprInfoByVars (boundVars: Val list, boundTyVars) ivalue = +let AbstractExprInfoByVars (cenv: cenv) (boundVars: Val list, boundTyVars) ivalue = // Module and member bindings can be skipped when checking abstraction, since abstraction of these values has already been done when // we hit the end of the module and called AbstractLazyModulInfoByHiding. If we don't skip these then we end up quadratically retraversing // the inferred optimization data, i.e. at each binding all the way up a sequences of 'lets' in a module. @@ -1479,7 +1488,7 @@ let AbstractExprInfoByVars (boundVars: Val list, boundTyVars) ivalue = let rec abstractModulInfo ss = { ModuleOrNamespaceInfos = ss.ModuleOrNamespaceInfos |> NameMap.map (InterruptibleLazy.force >> abstractModulInfo >> notlazy) ValInfos = ss.ValInfos.Map (fun (vref, e) -> - check vref (abstractValInfo e) ) } + check cenv vref (abstractValInfo e)) } abstractExprInfo ivalue @@ -1519,9 +1528,9 @@ let RemapOptimizationInfo g tmenv = remapLazyModulInfo /// Hide information when a value is no longer visible -let AbstractAndRemapModulInfo g (repackage, hidden) info = +let AbstractAndRemapModulInfo g (cenv: cenv) (repackage, hidden) info = let mrpi = mkRepackageRemapping repackage - let info = info |> AbstractLazyModulInfoByHiding false hidden + let info = info |> AbstractLazyModulInfoByHiding false cenv hidden let info = info |> RemapOptimizationInfo g mrpi info @@ -1692,6 +1701,7 @@ let TryEliminateBinding cenv _env bind e2 _m = not vspec1.IsCompilerGenerated then None elif vspec1.IsFixed then None + elif vspec1.InlineInfo = ValInline.InlinedDefinition then None elif vspec1.LogicalName.StartsWithOrdinal stackVarPrefix || vspec1.LogicalName.Contains suffixForVariablesThatMayNotBeEliminated then None else @@ -2334,6 +2344,17 @@ let inline IsStateMachineExpr g overallExpr = isReturnsResumableCodeTy g valRef.TauType | _ -> false +let shouldForceInlineMembersInDebug (g: TcGlobals) (tcref: EntityRef) = + match g.fslibForceInlineModules.TryGetValue tcref.LogicalName with + | true, modRef -> tyconRefEq g tcref modRef + | _ -> false + +let shouldForceInlineInDebug (g: TcGlobals) (vref: ValRef) : bool = + ValHasWellKnownAttribute g WellKnownValAttributes.NoDynamicInvocationAttribute_True vref.Deref || + ValHasWellKnownAttribute g WellKnownValAttributes.NoDynamicInvocationAttribute_False vref.Deref || + + vref.HasDeclaringEntity && shouldForceInlineMembersInDebug g vref.DeclaringEntity + /// Optimize/analyze an expression let rec OptimizeExpr cenv (env: IncrementalOptimizationEnv) expr = cenv.stackGuard.Guard <| fun () -> @@ -2832,7 +2853,7 @@ and OptimizeLetRec cenv env (binds, bodyExpr, m) = let fvs = List.fold (fun acc x -> unionFreeVars acc (fst x |> freeInBindingRhs CollectLocals)) fvs0 bindsR SplitValuesByIsUsedOrHasEffect cenv (fun () -> fvs.FreeLocals) bindsR // Trim out any optimization info that involves escaping values - let evalueR = AbstractExprInfoByVars (vs, []) einfo.Info + let evalueR = AbstractExprInfoByVars cenv (vs, []) einfo.Info // REVIEW: size of constructing new closures - should probably add #freevars + #recfixups here let bodyExprR = Expr.LetRec (bindsRR, bodyExprR, m, Construct.NewFreeVarsCache()) let info = CombineValueInfos (einfo :: bindinfos) evalueR @@ -2908,7 +2929,7 @@ and OptimizeLinearExpr cenv env expr contf = Info = UnknownValue } else // On the way back up: Trim out any optimization info that involves escaping values on the way back up - let evalueR = AbstractExprInfoByVars ([bindR.Var], []) bodyInfo.Info + let evalueR = AbstractExprInfoByVars cenv ([bindR.Var], []) bodyInfo.Info // Preserve the debug points for eliminated bindings that have debug points. let bodyR = @@ -3421,8 +3442,67 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = | _ -> None /// Attempt to inline an application of a known value at callsites -and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) = +and TryInlineApplication cenv env finfo (valExpr: Expr) (tyargs: TType list, args: Expr list, m) = let g = cenv.g + + match cenv.settings.inlineNamedFunctions, stripExpr valExpr with + | false, Expr.Val(vref, _, _) when vref.ShouldInline && not (shouldForceInlineInDebug cenv.g vref) -> + let origFinfo = GetInfoForValWithCheck cenv env m vref + match stripValue origFinfo.ValExprInfo with + | CurriedLambdaValue(origLambdaId, _, _, origLambda, origLambdaTy) when not (Zset.contains origLambdaId env.dontInline) -> + let argsR = args |> List.map (OptimizeExpr cenv env >> fst) + let info = { TotalSize = 1; FunctionSize = 1; HasEffect = true; MightMakeCriticalTailcall = false; Info = UnknownValue } + + let hasNoTraits = + let tps, _ = tryDestForallTy g vref.Type + GetTraitConstraintInfosOfTypars g tps |> List.isEmpty + + let allTyargsAreConcrete = + tyargs |> List.forall (fun t -> (freeInType CollectTyparsNoCaching t).FreeTypars.IsEmpty) + + let canCallDirectly = + hasNoTraits || (not allTyargsAreConcrete && vref.ValReprInfo.IsSome) + + if canCallDirectly then + Some(mkApps g ((exprForValRef m vref, vref.Type), [tyargs], argsR, m), info) + else + let f2R = CopyExprForInlining cenv true origLambda m + let specLambda = MakeApplicationAndBetaReduce g (f2R, origLambdaTy, [tyargs], [], m) + let specLambdaTy = tyOfExpr g specLambda + + let specLambdaR = + if allTyargsAreConcrete then + match cenv.specializedInlineVals.FindAll(origLambdaId) |> List.tryFind (fun (ty, _) -> typeEquiv g ty specLambdaTy) with + | Some (_, body) -> copyExpr g CloneAll body + | None -> + + let specLambdaR, _ = OptimizeExpr cenv { env with dontInline = Zset.add origLambdaId env.dontInline } specLambda + cenv.specializedInlineVals.Add(origLambdaId, (specLambdaTy, specLambdaR)) + specLambdaR + else + let specLambdaR, _ = OptimizeExpr cenv { env with dontInline = Zset.add origLambdaId env.dontInline } specLambda + specLambdaR + + let debugVal = + let name = $"<{vref.LogicalName}>__debug" + // When tyargs have free type variables, omit ValReprInfo so IlxGen compiles this + // as a closure that captures type variables and witnesses from the enclosing scope. + let valReprInfo = + if allTyargsAreConcrete then + Some(InferValReprInfoOfExpr g AllowTypeDirectedDetupling.No specLambdaTy [] [] specLambdaR) + else + None + + Construct.NewVal(name, m, None, specLambdaTy, Immutable, true, valReprInfo, taccessPublic, ValNotInRecScope, None, + NormalVal, [], ValInline.InlinedDefinition, XmlDoc.Empty, false, false, false, false, false, false, None, + ParentNone) + + let callExpr = mkApps g ((exprForVal m debugVal, specLambdaTy), [], argsR, m) + Some(mkCompGenLet m debugVal specLambdaR callExpr, info) + + | _ -> None + | _ -> + // Considering inlining app match finfo.Info with | StripLambdaValue (lambdaId, arities, size, f2, f2ty) when @@ -3621,7 +3701,7 @@ and OptimizeApplication cenv env (f0, f0ty, tyargs, args, m) = OptimizeExpr cenv env remade | Choice2Of2 (newf0, remake) -> - match TryInlineApplication cenv env finfo (tyargs, args, m) with + match TryInlineApplication cenv env finfo f0 (tyargs, args, m) with | Some (res, info) -> // inlined (res |> remake), info @@ -3869,6 +3949,10 @@ and OptimizeLambdas (vspec: Val option) cenv env valReprInfo expr exprTy = // can't inline any values with semi-recursive object references to self or base let value_ = + match vspec with + | Some v when v.InlineInfo = ValInline.InlinedDefinition -> UnknownValue + | _ -> + match baseValOpt with | None -> CurriedLambdaValue (lambdaId, arities, bsize, exprR, exprTy) | Some baseVal -> @@ -4017,7 +4101,7 @@ and OptimizeDecisionTreeTarget cenv env _m (TTarget(vs, expr, flags)) = let env = BindInternalValsToUnknown cenv vs env let exprR, einfo = OptimizeExpr cenv env expr let exprR, einfo = ConsiderSplitToMethod cenv.settings.abstractBigTargets cenv.settings.bigTargetSize cenv env (exprR, einfo) - let evalueR = AbstractExprInfoByVars (vs, []) einfo.Info + let evalueR = AbstractExprInfoByVars cenv (vs, []) einfo.Info TTarget(vs, exprR, flags), { TotalSize=einfo.TotalSize FunctionSize=einfo.FunctionSize @@ -4301,7 +4385,7 @@ and OptimizeModuleExprWithSig cenv env mty def = elimModuleDefn def - let info = AbstractAndRemapModulInfo g rpi info + let info = AbstractAndRemapModulInfo g cenv rpi info def, info @@ -4374,14 +4458,14 @@ and OptimizeImplFileInternal cenv env isIncrementalFragment hidden implFile = // This optimizes and builds minfo ignoring the signature let (defR, minfo), (_env, _bindInfosColl) = OptimizeModuleContents cenv (env, []) contents let hidden = ComputeImplementationHidingInfoAtAssemblyBoundary defR hidden - let minfo = AbstractLazyModulInfoByHiding false hidden minfo + let minfo = AbstractLazyModulInfoByHiding false cenv hidden minfo let env = BindValsInModuleOrNamespace cenv minfo env env, defR, minfo, hidden else // This optimizes and builds minfo w.r.t. the signature let mexprR, minfo = OptimizeModuleExprWithSig cenv env signature contents let hidden = ComputeSignatureHidingInfoAtAssemblyBoundary signature hidden - let minfoExternal = AbstractLazyModulInfoByHiding true hidden minfo + let minfoExternal = AbstractLazyModulInfoByHiding true cenv hidden minfo let env = BindValsInModuleOrNamespace cenv minfo env env, mexprR, minfoExternal, hidden @@ -4403,6 +4487,7 @@ let OptimizeImplFile (settings, ccu, tcGlobals, tcVal, importMap, optEnv, isIncr casApplied=Dictionary() stackGuard = StackGuard("OptimizerStackGuardDepth") realsig = tcGlobals.realsig + specializedInlineVals = HashMultiMap(HashIdentity.Structural, true) } let env, _, _, _ as results = OptimizeImplFileInternal cenv optEnv isIncrementalFragment hidden mimpls diff --git a/src/Compiler/Optimize/Optimizer.fsi b/src/Compiler/Optimize/Optimizer.fsi index 17912af7598..10335e93a64 100644 --- a/src/Compiler/Optimize/Optimizer.fsi +++ b/src/Compiler/Optimize/Optimizer.fsi @@ -51,6 +51,8 @@ type OptimizationSettings = reportTotalSizes: bool processingMode: OptimizationProcessingMode + + inlineNamedFunctions: bool } member JitOptimizationsEnabled: bool diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs index 08252dd76d5..6348ec64649 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -1857,7 +1857,7 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = match v.InlineInfo with | ValInline.Always -> FSharpInlineAnnotation.AlwaysInline | ValInline.Optional -> FSharpInlineAnnotation.OptionalInline - | ValInline.Never -> FSharpInlineAnnotation.NeverInline + | ValInline.Never | ValInline.InlinedDefinition -> FSharpInlineAnnotation.NeverInline member _.IsMutable = if isUnresolved() then false else diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index ef6e00ffb16..fc9d21ff8bc 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -646,6 +646,15 @@ type TcGlobals( yield nleref.LastItemMangledName, ERefNonLocal nleref ] + let v_FSharpCoreForceInlineModules = + dict [ for nleref in [ fslib_MFIntrinsicOperators_nleref + fslib_MFOperators_nleref + fslib_MFOperatorIntrinsics_nleref + fslib_MFOperatorsChecked_nleref + fslib_MFNativePtrModule_nleref ] do + + yield nleref.LastItemMangledName, ERefNonLocal nleref ] + let tryDecodeTupleTy tupInfo l = match l with | [t1;t2;t3;t4;t5;t6;t7;markerTy] -> @@ -1133,6 +1142,8 @@ type TcGlobals( // better the job we do of mapping from provided expressions back to FSharp.Core F# functions and values. member _.knownFSharpCoreModules = v_knownFSharpCoreModules + member _.fslibForceInlineModules = v_FSharpCoreForceInlineModules + member _.compilingFSharpCore = compilingFSharpCore member _.useReflectionFreeCodeGen = useReflectionFreeCodeGen diff --git a/src/Compiler/TypedTree/TcGlobals.fsi b/src/Compiler/TypedTree/TcGlobals.fsi index e27bc1605a2..214ad0d17cd 100644 --- a/src/Compiler/TypedTree/TcGlobals.fsi +++ b/src/Compiler/TypedTree/TcGlobals.fsi @@ -698,6 +698,8 @@ type internal TcGlobals = member knownFSharpCoreModules: System.Collections.Generic.IDictionary + member fslibForceInlineModules: System.Collections.Generic.IDictionary + member knownIntrinsics: System.Collections.Concurrent.ConcurrentDictionary diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 995071138b5..8a2f6f28400 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -41,21 +41,15 @@ type StampMap<'T> = Map [] type ValInline = - - /// Indicates the value is inlined but the .NET IL code for the function still exists, e.g. to satisfy interfaces on objects, but that it is also always inlined | Always - - /// Indicates the value may optionally be inlined by the optimizer | Optional - - /// Indicates the value must never be inlined by the optimizer | Never + | InlinedDefinition - /// Returns true if the implementation of a value should be inlined member x.ShouldInline = match x with | ValInline.Always -> true - | ValInline.Optional | ValInline.Never -> false + | ValInline.Optional | ValInline.Never | ValInline.InlinedDefinition -> false /// A flag associated with values that indicates whether the recursive scope of the value is currently being processed, and /// if the value has been generalized or not as yet. @@ -110,6 +104,7 @@ type ValFlags(flags: int64) = (if isCompGen then 0b00000000000000001000L else 0b000000000000000000000L) ||| (match inlineInfo with + | ValInline.InlinedDefinition -> 0b00000000000000000000L | ValInline.Always -> 0b00000000000000010000L | ValInline.Optional -> 0b00000000000000100000L | ValInline.Never -> 0b00000000000000110000L) ||| @@ -166,7 +161,7 @@ type ValFlags(flags: int64) = member x.InlineInfo = match (flags &&& 0b00000000000000110000L) with - | 0b00000000000000000000L + | 0b00000000000000000000L -> ValInline.InlinedDefinition | 0b00000000000000010000L -> ValInline.Always | 0b00000000000000100000L -> ValInline.Optional | 0b00000000000000110000L -> ValInline.Never diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index 0cd4bfd2305..3c317425c13 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -41,6 +41,9 @@ type ValInline = /// Indicates the value must never be inlined by the optimizer | Never + /// Indicates a debug-only value produced from inlining an 'inline' function definition. + | InlinedDefinition + /// Returns true if the implementation of a value must always be inlined member ShouldInline: bool diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 6896c33a6a4..4cd898ee342 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -1032,6 +1032,11 @@ Zobrazí povolené hodnoty pro jazykovou verzi. + + Inline named 'inline' functions + Inline named 'inline' functions + + Invalid use of emitting a reference assembly, do not use '--standalone or --staticlink' with '--refonly or --refout'. Neplatné použití generování referenčního sestavení, nepoužívejte --standalone ani --staticlink s --refonly nebo --refout. @@ -8952,12 +8957,12 @@ Rozšíření správce závislostí {0} nešlo načíst. Zpráva: {1} - + Warn when a function value is used as an interpolated string argument Warn when a function value is used as an interpolated string argument - + This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 3966a59a853..95d6c30cfb6 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -1032,6 +1032,11 @@ Anzeigen der zulässigen Werte für die Sprachversion. + + Inline named 'inline' functions + Inline named 'inline' functions + + Invalid use of emitting a reference assembly, do not use '--standalone or --staticlink' with '--refonly or --refout'. Ungültige Verwendung der Ausgabe einer Referenzassembly. Verwenden Sie nicht „--standalone“ oder „--staticlink“ mit „--refonly“ oder „--refout“. @@ -8952,12 +8957,12 @@ Die Abhängigkeits-Manager-Erweiterung "{0}" konnte nicht geladen werden. Meldung: {1} - + Warn when a function value is used as an interpolated string argument Warn when a function value is used as an interpolated string argument - + This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index 08828606dd6..2b680093a77 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -1032,6 +1032,11 @@ Muestra los valores permitidos para la versión del lenguaje. + + Inline named 'inline' functions + Inline named 'inline' functions + + Invalid use of emitting a reference assembly, do not use '--standalone or --staticlink' with '--refonly or --refout'. Uso no válido de emisión de un ensamblado de referencia, no use '--standalone or --staticlink' con '--refonly or --refout'. @@ -8952,12 +8957,12 @@ No se pudo cargar la extensión del administrador de dependencias {0}. Mensaje: {1} - + Warn when a function value is used as an interpolated string argument Warn when a function value is used as an interpolated string argument - + This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 5a28ec15953..1995b80fcc0 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -1032,6 +1032,11 @@ Affichez les valeurs autorisées pour la version du langage. + + Inline named 'inline' functions + Inline named 'inline' functions + + Invalid use of emitting a reference assembly, do not use '--standalone or --staticlink' with '--refonly or --refout'. Utilisation non valide de l’émission d’un assembly de référence, n’utilisez pas '--standalone ou --staticlink' avec '--refonly ou --refout'. @@ -8952,12 +8957,12 @@ Impossible de charger l'extension du gestionnaire de dépendances {0}. Message : {1} - + Warn when a function value is used as an interpolated string argument Warn when a function value is used as an interpolated string argument - + This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 5dead052c6a..ed72202e21b 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -1032,6 +1032,11 @@ Visualizzare i valori consentiti per la versione della lingua. + + Inline named 'inline' functions + Inline named 'inline' functions + + Invalid use of emitting a reference assembly, do not use '--standalone or --staticlink' with '--refonly or --refout'. Utilizzo non valido della creazione di un assembly di riferimento. Non usare insieme '--standalone o --staticlink' con '--refonly o --refout'.. @@ -8952,12 +8957,12 @@ Non è stato possibile caricare l'estensione {0} di gestione delle dipendenze. Messaggio: {1} - + Warn when a function value is used as an interpolated string argument Warn when a function value is used as an interpolated string argument - + This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index f491fb0c4c5..836f2b3fa80 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -1032,6 +1032,11 @@ 言語バージョンで許可されている値を表示します。 + + Inline named 'inline' functions + Inline named 'inline' functions + + Invalid use of emitting a reference assembly, do not use '--standalone or --staticlink' with '--refonly or --refout'. 参照アセンブリの出力の使用が無効です。'--standalone または --staticlink' を '--relabelly または --refout' と共に使用しないでください。 @@ -8952,12 +8957,12 @@ 依存関係マネージャーの拡張機能 {0} を読み込むことができませんでした。メッセージ: {1} - + Warn when a function value is used as an interpolated string argument Warn when a function value is used as an interpolated string argument - + This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index f8185fb2a22..5378e0c8b9c 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -1032,6 +1032,11 @@ 언어 버전에 허용되는 값을 표시합니다. + + Inline named 'inline' functions + Inline named 'inline' functions + + Invalid use of emitting a reference assembly, do not use '--standalone or --staticlink' with '--refonly or --refout'. 참조 어셈블리 내보내기를 잘못 사용했습니다. '--refonly 또는 --refout'과 함께 '--standalone 또는 --staticlink'를 사용하지 마세요. @@ -8952,12 +8957,12 @@ 종속성 관리자 확장 {0}을(를) 로드할 수 없습니다. 메시지: {1} - + Warn when a function value is used as an interpolated string argument Warn when a function value is used as an interpolated string argument - + This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index 7e81e135eeb..c84c5bbf129 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -1032,6 +1032,11 @@ Wyświetl dozwolone wartości dla wersji językowej. + + Inline named 'inline' functions + Inline named 'inline' functions + + Invalid use of emitting a reference assembly, do not use '--standalone or --staticlink' with '--refonly or --refout'. Nieprawidłowe użycie emitowania zestawu odwołania. Nie używaj elementu „--standalone ani --staticlink” z elementem „--refonly lub --refout”. @@ -8952,12 +8957,12 @@ Nie można załadować rozszerzenia menedżera zależności {0}. Komunikat: {1} - + Warn when a function value is used as an interpolated string argument Warn when a function value is used as an interpolated string argument - + This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 22a5db4504c..86ba8ffb2de 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -1032,6 +1032,11 @@ Exiba os valores permitidos para a versão do idioma. + + Inline named 'inline' functions + Inline named 'inline' functions + + Invalid use of emitting a reference assembly, do not use '--standalone or --staticlink' with '--refonly or --refout'. Uso inválido da emissão de um assembly de referência, não use '--standalone ou --staticlink' com '--refonly ou --refout'. @@ -8952,12 +8957,12 @@ Não foi possível carregar a extensão do gerenciador de dependências {0}. Mensagem: {1} - + Warn when a function value is used as an interpolated string argument Warn when a function value is used as an interpolated string argument - + This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 8f5220ba47e..be60184841a 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -1032,6 +1032,11 @@ Отображение допустимых значений для версии языка. + + Inline named 'inline' functions + Inline named 'inline' functions + + Invalid use of emitting a reference assembly, do not use '--standalone or --staticlink' with '--refonly or --refout'. Недопустимое использование при создании базовой сборки. Не используйте "--standalone or --staticlink" с "--refonly or --refout". @@ -8952,12 +8957,12 @@ Не удалось загрузить расширение диспетчера зависимостей {0}. Сообщение: {1} - + Warn when a function value is used as an interpolated string argument Warn when a function value is used as an interpolated string argument - + This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index 17509827124..64a85b582f9 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -1032,6 +1032,11 @@ Dil sürümü için izin verilen değerleri görüntüleyin. + + Inline named 'inline' functions + Inline named 'inline' functions + + Invalid use of emitting a reference assembly, do not use '--standalone or --staticlink' with '--refonly or --refout'. Başvuru bütünleştirilmiş kodu oluşturmanın geçersiz kullanımı; '--standalone’ veya ‘--staticlink' seçeneğini '--refonly’ veya ‘--refout' ile birlikte kullanmayın. @@ -8952,12 +8957,12 @@ {0} bağımlılık yöneticisi uzantısı yüklenemedi. İleti: {1} - + Warn when a function value is used as an interpolated string argument Warn when a function value is used as an interpolated string argument - + This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index bf26625f8ec..6ccf9a7c77b 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -1032,6 +1032,11 @@ 显示语言版本的允许值。 + + Inline named 'inline' functions + Inline named 'inline' functions + + Invalid use of emitting a reference assembly, do not use '--standalone or --staticlink' with '--refonly or --refout'. 发出引用程序集的使用无效，请勿将 '--standalone 或 --staticlink' 与 '--refonly 或 --refout' 一起使用。 @@ -8952,12 +8957,12 @@ 无法加载依赖项管理器扩展 {0}。消息: {1} - + Warn when a function value is used as an interpolated string argument Warn when a function value is used as an interpolated string argument - + This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index 2a63e5ad753..360bfd1ede5 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -1032,6 +1032,11 @@ 顯示語言版本的允許值。 + + Inline named 'inline' functions + Inline named 'inline' functions + + Invalid use of emitting a reference assembly, do not use '--standalone or --staticlink' with '--refonly or --refout'. 發出參考組件的使用無效，請勿同時使用 '--standalone 或 '--refonly' 和 '--refout'。 @@ -8952,12 +8957,12 @@ 無法載入相依性管理員延伸模組 {0}。訊息: {1} - + Warn when a function value is used as an interpolated string argument Warn when a function value is used as an interpolated string argument - + This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. This expression is a function value. When used in an interpolated string it will be formatted using its 'ToString' method, which is likely not the intended behavior. Consider applying the function to its arguments. diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/misc/compiler_help_output.bsl b/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/misc/compiler_help_output.bsl index 3cfd389dc8a..b87d8aa6971 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/misc/compiler_help_output.bsl +++ b/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/misc/compiler_help_output.bsl @@ -84,6 +84,7 @@ Copyright (c) Microsoft Corporation. All Rights Reserved. --checked[+|-] Generate overflow checks (off by default) --define: Define conditional compilation symbols (Short form: -d) --strict-indentation[+|-] Override indentation rules implied by the language version (off by default) +--inline-named-functions[+|-] Inline named 'inline' functions - MISCELLANEOUS - diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/DebugInlineAsCall.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/DebugInlineAsCall.fs new file mode 100644 index 00000000000..a1f62dfb85e --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/DebugInlineAsCall.fs @@ -0,0 +1,722 @@ +namespace EmittedIL + +open Xunit +open FSharp.Test.Compiler + +module DebugInlineAsCall = + + [] + let ``Call 01 - Release`` () = + FSharp """ +let inline f (x: int) = + x + x + +let i = f 5 +""" + |> asExe + |> compile + |> verifyILContains ["ldc.i4.s 10"] + |> shouldSucceed + + [] + let ``Call 02 - Debug`` () = + FSharp """ +let inline f (x: int) = + x + x + +[] +let main _ = + let i = f 5 + if i = 10 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains ["call int32 Test::f(int32)"] + |> shouldSucceed + + [] + let ``Call 03 - Two args`` () = + FSharp """ + +let inline add a b = + a + b + +[] +let main _ = + let i = add 1 2 + if i = 3 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains ["call int32 Test::'__debug@8'(int32,"] + |> shouldSucceed + + [] + let ``Call 04 - Function arg`` () = + FSharp """ +let inline apply (f: 'a -> 'b -> 'c) (x: 'a) (y: 'b) : 'c = + f x y + +[] +let main _ = + let i = apply (+) 3 4 + if i = 7 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains ["call !!2 Test::apply(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>,"] + |> shouldSucceed + + + [] + let ``Call 05 - Nested inline`` () = + FSharp """ +let inline double (x: int) = + x + x + +let inline quadruple (x: int) = + double (double x) + +[] +let main _ = + let i = quadruple 3 + if i = 12 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains + ["call int32 Test::double(int32)" + "call int32 Test::quadruple(int32)"] + |> shouldSucceed + + [] + let ``Call 06 - Multiple calls`` () = + FSharp """ +let inline double (x: int) = + x + x + +[] +let main _ = + let i = double 1 + double 2 + if i = 6 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains [ "call int32 Test::double(int32)" ] + + [] + let ``Call 07 - Local function`` () = + FSharp """ +[] +let main _ = + let inline double (x: int) = x + x + let i = double 5 + if i = 10 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains ["callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0)"] + |> shouldSucceed + + [] + let ``Call 08 - Local generic function`` () = + FSharp """ +[] +let main _ = + let inline apply (f: 'a -> 'b) (x: 'a) : 'b = f x + let i = apply (fun x -> x + 1) 5 + if i = 6 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains ["call !!0 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,int32>::InvokeFast(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>,"] + |> shouldSucceed + + [] + let ``Call 09 - FSharp.Core not`` () = + FSharp """ +[] +let main _ = + let b = not true + if b = false then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILNotPresent ["call bool [FSharp.Core]Microsoft.FSharp.Core.Operators::Not(bool)"] + + [] + let ``Call 10 - Different assembly`` () = + let library = + FSharp """ +module MyLib + +let inline triple (x: int) = x + x + x +""" + |> withDebug + |> withNoOptimize + |> asLibrary + |> withName "Library" + + FSharp """ +open MyLib + +[] +let main _ = + let i = triple 3 + if i = 9 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> withReferences [library] + |> asExe + |> compileAndRun + |> verifyILContains ["call int32 [Library]MyLib::triple(int32)"] + |> shouldSucceed + + [] + let ``Call 11 - Measure`` () = + FSharp """ +[] type cm + +let inline scale (x: float<'u>) = x * 2.0 + +[] +let main _ = + let v = scale 5.0 + if v = 10.0 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains ["call float64 Test::scale(float64)"] + |> shouldSucceed + + [] + let ``Call 12 - No inner optimization`` () = + FSharp """ +[] +let main _ = + let inline f (x: int) = + let i = 5 + 10 + x + i + + let i = f 20 + if i = 35 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains + [ "ldc.i4.5" + "ldc.i4.s 10" + "callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0)" ] + |> shouldSucceed + + [] + let ``SRTP 01`` () = + FSharp """ +let inline add (x: ^T) (y: ^T) = + x + y + +[] +let main _ = + let i = add 3 4 + if i = 7 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains ["call int32 Test::'__debug@7'(int32,"] + |> shouldSucceed + + [] + let ``SRTP 02 - Local `` () = + FSharp """ +[] +let main _ = + let inline add (x: ^T) (y: ^T) = x + y + let i = add 3 4 + if i = 7 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains ["call int32 Test::'__debug@5'(int32,"] + |> shouldSucceed + + [] + let ``SRTP 03 - Different type arguments`` () = + FSharp """ +let inline getLength (x: ^T) = + (^T : (member Length : int) x) + +[] +let main _ = + let i = getLength "hello" + let j = getLength [1; 2; 3] + if i = 5 && j = 3 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains + [ "call int32 Test::'__debug@7'(string)" + "call int32 Test::'__debug@8-1'(class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1)" ] + |> shouldSucceed + + [] + let ``SRTP 04 - Multiple calls`` () = + FSharp """ +let inline add (x: ^T) (y: ^T) = x + y + +[] +let main _ = + let i = add 1 2 + add 3 4 + if i = 10 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains + [ "call int32 Test::'__debug@6'(int32," + "call int32 Test::'__debug@6-1'(int32," ] + |> shouldSucceed + + + [] + let ``SRTP 05 - Different assembly`` () = + let library = + FSharp """ +module MyLib + +let inline add (x: ^T) (y: ^T) = x + y +""" + |> withDebug + |> withNoOptimize + |> asLibrary + + FSharp """ +open MyLib + +[] +let main _ = + let i = add 3 4 + if i = 7 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> withReferences [library] + |> asExe + |> compileAndRun + |> verifyILContains ["call int32 Test::'__debug@6'(int32,"] + |> shouldSucceed + + [] + let ``SRTP 06 - Different assembly`` () = + let library = + FSharp """ +module MyLib + +let inline add (x: ^T) (y: ^T) = x + y +""" + |> withDebug + |> withNoOptimize + |> asLibrary + + FSharp """ +open MyLib + +let inline double (x: ^T) = add x x + +[] +let main _ = + let i = double 5 + if i = 10 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> withReferences [library] + |> asExe + |> compileAndRun + |> verifyILContains + [ "call int32 Test::'__debug@8'(int32)" + "call int32 Test::'__debug@4'(int32," ] + |> shouldSucceed + + [] + let ``SRTP 07 - Nested - Same project`` () = + FSharp """ +let inline add (x: ^T) (y: ^T) = x + y + +let inline double (x: ^T) = add x x + +[] +let main _ = + let i = double 5 + if i = 10 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains + [ "call int32 Test::'__debug@8'(int32)" + "call int32 Test::'__debug@4'(int32," ] + |> shouldSucceed + + + + [] + let ``SRTP 08 - Nested - Different type arguments`` () = + FSharp """ +let inline add (x: ^T) (y: ^T) = x + y + +let inline addBoth (x: ^A) (y: ^B) = + let a = add x x + let b = add y y + (a, b) + +[] +let main _ = + let (a, b) = addBoth 2 3.0 + if a = 4 && b = 6.0 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains + [ "call int32 Test::'__debug@5'(int32," + "call float64 Test::'__debug@6-1'(float64," ] + |> shouldSucceed + + [] + let ``SRTP 09 - Witness`` () = + FSharp """ +let check s (b1: 'a) (b2: 'a) = if b1 = b2 then () else failwith s + +let inline add (x: ^T) (y: ^T) = x + y + +[] +let main _ = + check "int" (add 3 4) 7 + check "float" (add 1.0 2.0) 3.0 + 0 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> shouldSucceed + + [] + let ``SRTP 10 - Witness`` () = + FSharp """ +type MyNum = + { Value: float } + static member FromFloat (_: MyNum) = fun (x: float) -> { Value = x } + +type T = + static member inline Invoke(x: float) : 'Num = + let inline call (a: ^a) = (^a: (static member FromFloat : _ -> _) a) + call Unchecked.defaultof<'Num> x + +[] +let main _ = + let result = T.Invoke(3.14) + if result.Value = 3.14 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains [ "call class Test/MyNum Test::'__debug@13'(float64)" ] + |> shouldSucceed + + [] + let ``SRTP 11 - Witness`` () = + FSharp """ +type MyNum = + { Value: float } + static member FromFloat (_: MyNum, _: T) = fun (x: float) -> { Value = x } + +and T = + { Dummy: int } + static member inline Invoke(x: float) : 'Num = + let inline call2 (a: ^a, b: ^b) = ((^a or ^b) : (static member FromFloat : _ * _ -> _) (b, a)) + let inline call (a: 'a) = fun (x: 'x) -> call2 (a, Unchecked.defaultof<'r>) x : 'r + call Unchecked.defaultof x + +[] +let main _ = + let result = T.Invoke(2.71) + if result.Value = 2.71 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains [ "call class Test/MyNum Test::'__debug@15'(float64)" ] + |> shouldSucceed + + + [] + let ``Member 01 - Non-generic`` () = + FSharp """ +type T() = + member inline _.Double(x: int) = x + x + +[] +let main _ = + let t = T() + let i = t.Double(5) + if i = 10 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains ["callvirt instance int32 Test/T::Double(int32)"] + |> shouldSucceed + + [] + let ``Member 02 - Generic`` () = + FSharp """ +type T() = + member inline _.Apply(f: 'a -> 'b, x: 'a) : 'b = f x + +[] +let main _ = + let t = T() + let i = t.Apply((fun x -> x + 1), 5) + if i = 6 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains ["callvirt instance !!1 Test/T::Apply(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,"] + |> shouldSucceed + + [] + let ``Member 03 - SRTP`` () = + FSharp """ +type T() = + member inline _.Add(x: ^T, y: ^T) = x + y + +[] +let main _ = + let t = T() + let i = t.Add(3, 4) + if i = 7 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains ["call int32 Test::'__debug@8'(class Test/T,"] + |> shouldSucceed + + [] + let ``Operator 01 - Top-level`` () = + FSharp """ +let inline (++) (x: int) (y: int) = x + y + 1 + +[] +let main _ = + let i = 3 ++ 4 + if i = 8 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains ["call int32 Test::op_PlusPlus(int32,"] + |> shouldSucceed + + [] + let ``Operator 02 - Top-level SRTP`` () = + FSharp """ +let inline (++) (x: ^T) (y: ^T) = x + y + +[] +let main _ = + let i = 3 ++ 4 + if i = 7 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains ["call int32 Test::'__debug@6'(int32,"] + |> shouldSucceed + + [] + let ``Operator 03 - Local`` () = + FSharp """ +[] +let main _ = + let inline (++) (x: int) (y: int) = x + y + 1 + let i = 3 ++ 4 + if i = 8 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains ["call !!0 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::InvokeFast(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>,"] + |> shouldSucceed + + [] + let ``Operator 04 - Local SRTP`` () = + FSharp """ +[] +let main _ = + let inline (++) (x: ^T) (y: ^T) = x + y + let i = 3 ++ 4 + if i = 7 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains ["call int32 Test::'__debug@5'(int32,"] + |> shouldSucceed + + [] + let ``Accessibility 01`` () = + FSharp """ +let inline internal fInternal () = () +let inline f () = fInternal () + +[] +let main _ = + f () + 0 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains + [ "call void Test::f()" + "call void Test::fInternal()" ] + |> shouldSucceed + + [] + let ``Accessibility 02`` () = + FSharp """ +type T() = + member inline internal this.InternalMethod() = + () + + member inline this.Method() = + this.InternalMethod() + +[] +let main _ = + T().Method() + 0 +""" + |> withDebug + |> withNoOptimize + |> asExe + |> compileAndRun + |> verifyILContains + [ "callvirt instance void Test/T::Method()" + "callvirt instance void Test/T::InternalMethod()" ] + |> shouldSucceed + + [] + let ``Accessibility 03 - Cross-project SRTP`` () = + let library = + FSharp """ +module MyLib + +let inline internal addInternal (x: ^T) (y: ^T) = x + y +let inline addPublic (x: ^T) (y: ^T) = addInternal x y +""" + |> withDebug + |> withNoOptimize + |> asLibrary + + FSharp """ +open MyLib + +[] +let main _ = + let i = addPublic 3 4 + if i = 7 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> withReferences [library] + |> asExe + |> compileAndRun + |> verifyILContains + [ "call int32 Test::'__debug@6'(int32," + "call int32 Test::'__debug@1'(int32," ] + |> shouldSucceed + + [] + let ``Accessibility 04 - Cross-project witness`` () = + let library = + FSharp """ +module Module + +type MyNum = + { Value: float } + static member FromFloat (_: MyNum) = fun (x: float) -> { Value = x } + +type T = + static member inline internal InvokeInternal(x: float) : 'Num = + let inline call (a: ^a) = (^a: (static member FromFloat : _ -> _) a) + call Unchecked.defaultof<'Num> x + + static member inline Invoke(x: float) : 'Num = + T.InvokeInternal<'Num>(x) +""" + |> withDebug + |> withNoOptimize + |> asLibrary + |> withName "Library" + + FSharp """ +open Module + +[] +let main _ = + let result = T.Invoke(3.14) + if result.Value = 3.14 then 0 else 1 +""" + |> withDebug + |> withNoOptimize + |> withReferences [library] + |> asExe + |> compileAndRun + |> verifyILContains + [ "call class [Library]Module/MyNum Test::'__debug@6'(float64)" + "call class [Library]Module/MyNum Test::'__debug@1'(float64)" ] + |> shouldSucceed diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index f5d1048408e..0a891f7dfd5 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -227,6 +227,7 @@ +