Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Improve debugging of retail and inline code by not erasing locals and debug points intra-assembly #11717

Merged
merged 7 commits into from
Jul 2, 2021
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
4 changes: 2 additions & 2 deletions src/fsharp/DetupleArgs.fs
Original file line number Diff line number Diff line change
Expand Up @@ -715,15 +715,15 @@ let fixupApp (penv: penv) (fx, fty, tys, args, m) =

// Is it a val app, where the val has a transform?
match fx with
| Expr.Val (vref, _, m) ->
| Expr.Val (vref, _, vm) ->
let f = vref.Deref
match hasTransfrom penv f with
| Some trans ->
// fix it
let callPattern = trans.transformCallPattern
let transformedVal = trans.transformedVal
let fCty = transformedVal.Type
let fCx = exprForVal m transformedVal
let fCx = exprForVal vm transformedVal
(* [[f tps args ]] -> transformedVal tps [[COLLAPSED: args]] *)
let env = {prefix = "arg";m = m;eg=penv.g}
let bindings = []
Expand Down
25 changes: 13 additions & 12 deletions src/fsharp/InnerLambdasToTopLevelFuncs.fs
Original file line number Diff line number Diff line change
Expand Up @@ -967,13 +967,14 @@ module Pass4_RewriteAssembly =
// pass4: lowertop - convert_vterm_bind on TopLevel binds
//-------------------------------------------------------------------------

let ConvertBind g (TBind(v, repr, _) as bind) =
let AdjustBindToTopVal g (TBind(v, repr, _)) =
match v.ValReprInfo with
| None -> v.SetValReprInfo (Some (InferArityOfExprBinding g AllowTypeDirectedDetupling.Yes v repr ))
| None ->
v.SetValReprInfo (Some (InferArityOfExprBinding g AllowTypeDirectedDetupling.Yes v repr ))
// Things that don't have an arity from type inference but are top-level are compiler-generated
v.SetIsCompilerGenerated(true)
| Some _ -> ()

bind

//-------------------------------------------------------------------------
// pass4: transBind (translate)
//-------------------------------------------------------------------------
Expand Down Expand Up @@ -1035,6 +1036,9 @@ module Pass4_RewriteAssembly =
| None -> List.empty // no env for this mutual binding
| Some envp -> envp.ep_pack // environment pack bindings

let forceTopBindToHaveArity penv (bind: Binding) =
if penv.topValS.Contains(bind.Var) then AdjustBindToTopVal penv.g bind

let TransBindings xisRec penv (binds: Bindings) =
let tlrBs, nonTlrBs = binds |> List.partition (fun b -> Zset.contains b.Var penv.tlrS)
let fclass = BindingGroupSharingSameReqdItems tlrBs
Expand All @@ -1045,12 +1049,9 @@ module Pass4_RewriteAssembly =
// QUERY: we repeat this logic in LowerCallsAndSeqs. Do we really need to do this here?
// QUERY: yes and no - if we don't, we have an unrealizable term, and many decisions must
// QUERY: correlate with LowerCallsAndSeqs.
let forceTopBindToHaveArity (bind: Binding) =
if penv.topValS.Contains(bind.Var) then ConvertBind penv.g bind
else bind

let nonTlrBs = nonTlrBs |> List.map forceTopBindToHaveArity
let tlrRebinds = tlrRebinds |> List.map forceTopBindToHaveArity
nonTlrBs |> List.iter (forceTopBindToHaveArity penv)
tlrRebinds |> List.iter (forceTopBindToHaveArity penv)
// assemble into replacement bindings
let bindAs, rebinds =
match xisRec with
Expand All @@ -1067,7 +1068,7 @@ module Pass4_RewriteAssembly =
// Is it a val app, where the val f is TLR with arity wf?
// CLEANUP NOTE: should be using a mkApps to make all applications
match fx with
| Expr.Val (fvref: ValRef, _, m) when
| Expr.Val (fvref: ValRef, _, vm) when
(Zset.contains fvref.Deref penv.tlrS) &&
(let wf = Zmap.force fvref.Deref penv.arityM ("TransApp - wf", nameOfVal)
IsArityMet fvref wf tys args) ->
Expand All @@ -1078,9 +1079,9 @@ module Pass4_RewriteAssembly =
let envp = Zmap.force fc penv.envPackM ("TransApp - envp", string)
let fHat = Zmap.force f penv.fHatM ("TransApp - fHat", nameOfVal)
let tys = (List.map mkTyparTy envp.ep_etps) @ tys
let aenvExprs = List.map (exprForVal m) envp.ep_aenvs
let aenvExprs = List.map (exprForVal vm) envp.ep_aenvs
let args = aenvExprs @ args
mkApps penv.g ((exprForVal m fHat, fHat.Type), [tys], args, m) (* change, direct fHat call with closure (reqdTypars, aenvs) *)
mkApps penv.g ((exprForVal vm fHat, fHat.Type), [tys], args, m) (* change, direct fHat call with closure (reqdTypars, aenvs) *)
| _ ->
if isNil tys && isNil args then
fx
Expand Down
69 changes: 47 additions & 22 deletions src/fsharp/Optimizer.fs
Original file line number Diff line number Diff line change
Expand Up @@ -97,13 +97,13 @@ type ExprValueInfo =

| ConstValue of Const * TType

/// CurriedLambdaValue(id, arity, size, lambdaExpression, ty)
/// CurriedLambdaValue(id, arity, size, lambdaExpression, isCrossAssembly, ty)
///
/// arities: The number of bunches of untupled args and type args, and
/// the number of args in each bunch. NOTE: This include type arguments.
/// expr: The value, a lambda term.
/// ty: The type of lambda term
| CurriedLambdaValue of id: Unique * arity: int * size: int * value: Expr * TType
| CurriedLambdaValue of id: Unique * arity: int * size: int * lambdaExpr: Expr * isCrossAssembly: bool * lambdaExprTy: TType

/// ConstExprValue(size, value)
| ConstExprValue of size: int * value: Expr
Expand Down Expand Up @@ -202,7 +202,7 @@ let rec exprValueInfoL g exprVal =
| TupleValue vinfos -> bracketL (exprValueInfosL g vinfos)
| RecdValue (_, vinfos) -> braceL (exprValueInfosL g vinfos)
| UnionCaseValue (ucr, vinfos) -> unionCaseRefL ucr ^^ bracketL (exprValueInfosL g vinfos)
| CurriedLambdaValue(_lambdaId, _arities, _bsize, expr, _ety) -> wordL (tagText "lam") ++ exprL expr (* (sprintf "lam(size=%d)" bsize) *)
| CurriedLambdaValue(_lambdaId, _arities, _bsize, expr, _isCrossAssembly, _ety) -> wordL (tagText "lam") ++ exprL expr (* (sprintf "lam(size=%d)" bsize) *)
| ConstExprValue (_size, x) -> exprL x

and exprValueInfosL g vinfos = commaListL (List.map (exprValueInfoL g) (Array.toList vinfos))
Expand Down Expand Up @@ -252,7 +252,7 @@ and SizeOfValueInfo x =
| TupleValue vinfos
| RecdValue (_, vinfos)
| UnionCaseValue (_, vinfos) -> 1 + SizeOfValueInfos vinfos
| CurriedLambdaValue(_lambdaId, _arities, _bsize, _expr, _ety) -> 1
| CurriedLambdaValue _ -> 1
| ConstExprValue (_size, _) -> 1

let [<Literal>] minDepthForASizeNode = 5 // for small vinfos do not record size info, save space
Expand All @@ -279,7 +279,7 @@ let BoundValueInfoBySize vinfo =
| UnionCaseValue (ucr, vinfos) -> UnionCaseValue (ucr, Array.map (bound (depth-1)) vinfos)
| ConstValue _ -> x
| UnknownValue -> x
| CurriedLambdaValue(_lambdaId, _arities, _bsize, _expr, _ety) -> x
| CurriedLambdaValue _ -> x
| ConstExprValue (_size, _) -> x
let maxDepth = 6 (* beware huge constants! *)
let trimDepth = 3
Expand Down Expand Up @@ -661,7 +661,7 @@ let (|StripConstValue|_|) ev =

let (|StripLambdaValue|_|) ev =
match stripValue ev with
| CurriedLambdaValue (id, arity, sz, expr, ty) -> Some (id, arity, sz, expr, ty)
| CurriedLambdaValue (id, arity, sz, expr, isCrossAssembly, ty) -> Some (id, arity, sz, expr, isCrossAssembly, ty)
| _ -> None

let destTupleValue ev =
Expand Down Expand Up @@ -1064,7 +1064,7 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi =
else ValValue (vref2, detailR)

// Check for escape in lambda
| CurriedLambdaValue (_, _, _, expr, _) | ConstExprValue(_, expr) when
| CurriedLambdaValue (_, _, _, expr, _, _) | ConstExprValue(_, expr) when
(let fvs = freeInExpr CollectAll expr
(isAssemblyBoundary && not (freeVarsAllPublic fvs)) ||
Zset.exists hiddenVal fvs.FreeLocals ||
Expand Down Expand Up @@ -1158,7 +1158,7 @@ let AbstractExprInfoByVars (boundVars: Val list, boundTyVars) ivalue =
ValValue (v2, detailR)

// Check for escape in lambda
| CurriedLambdaValue (_, _, _, expr, _) | ConstExprValue(_, expr) when
| CurriedLambdaValue (_, _, _, expr, _, _) | ConstExprValue(_, expr) when
(let fvs = freeInExpr (if isNil boundTyVars then CollectLocals else CollectTyparsAndLocals) expr
(not (isNil boundVars) && List.exists (Zset.memberOf fvs.FreeLocals) boundVars) ||
(not (isNil boundTyVars) && List.exists (Zset.memberOf fvs.FreeTyvars.FreeTypars) boundTyVars) ||
Expand Down Expand Up @@ -1207,7 +1207,7 @@ let RemapOptimizationInfo g tmenv =
| UnionCaseValue(cspec, vinfos) -> UnionCaseValue (remapUnionCaseRef tmenv.tyconRefRemap cspec, Array.map remapExprInfo vinfos)
| SizeValue(_vdepth, vinfo) -> MakeSizedValueInfo (remapExprInfo vinfo)
| UnknownValue -> UnknownValue
| CurriedLambdaValue (uniq, arity, sz, expr, ty) -> CurriedLambdaValue (uniq, arity, sz, remapExpr g CloneAll tmenv expr, remapPossibleForallTy g tmenv ty)
| CurriedLambdaValue (uniq, arity, sz, expr, isCrossAssembly, ty) -> CurriedLambdaValue (uniq, arity, sz, remapExpr g CloneAll tmenv expr, isCrossAssembly, remapPossibleForallTy g tmenv ty)
| ConstValue (c, ty) -> ConstValue (c, remapPossibleForallTy g tmenv ty)
| ConstExprValue (sz, expr) -> ConstExprValue (sz, remapExpr g CloneAll tmenv expr)

Expand Down Expand Up @@ -2557,6 +2557,17 @@ and OptimizeTraitCall cenv env (traitInfo, args, m) =
let argsR, arginfos = OptimizeExprsThenConsiderSplits cenv env args
OptimizeExprOpFallback cenv env (TOp.TraitCall traitInfo, [], argsR, m) arginfos UnknownValue

and CopyExprForInlining cenv isCrossAssembly expr m =
if isCrossAssembly then
// Debug points are erased when doing cross-assembly inlining
// Locals are marked compiler generated when doing cross-assembly inlining
expr
|> copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated
|> remarkExpr m
else
expr
|> copyExpr cenv.g CloneAll

/// Make optimization decisions once we know the optimization information
/// for a value
and TryOptimizeVal cenv env (vOpt: ValRef option, mustInline, valInfoForVal, m) =
Expand All @@ -2579,9 +2590,10 @@ and TryOptimizeVal cenv env (vOpt: ValRef option, mustInline, valInfoForVal, m)
// If we have proven 'v = compilerGeneratedValue'
// and 'v' is being eliminated in favour of 'compilerGeneratedValue'
// then replace the name of 'compilerGeneratedValue'
// by 'v' and mark it not compiler generated so we preserve good debugging and names
// by 'v' and mark it not compiler generated so we preserve good debugging and names.
// Don't do this for things represented statically as it may publish multiple values with the same name.
match vOpt with
| Some v when not v.IsCompilerGenerated && vR.IsCompilerGenerated ->
| Some v when not v.IsCompilerGenerated && vR.IsCompilerGenerated && not vR.IsCompiledAsTopLevel && not v.IsCompiledAsTopLevel ->
vR.Deref.SetIsCompilerGenerated(false)
vR.Deref.SetLogicalName(v.LogicalName)
| _ -> ()
Expand All @@ -2590,8 +2602,9 @@ and TryOptimizeVal cenv env (vOpt: ValRef option, mustInline, valInfoForVal, m)
| ConstExprValue(_size, expr) ->
Some (remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated expr))

| CurriedLambdaValue (_, _, _, expr, _) when mustInline ->
Some (remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated expr))
| CurriedLambdaValue (_, _, _, expr, isCrossAssembly, _) when mustInline ->
let exprCopy = CopyExprForInlining cenv isCrossAssembly expr m
Some exprCopy

| TupleValue _ | UnionCaseValue _ | RecdValue _ when mustInline ->
failwith "tuple, union and record values cannot be marked 'inline'"
Expand Down Expand Up @@ -2887,7 +2900,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) =
// Considering inlining app
match finfo.Info with
| StripLambdaValue (lambdaId, arities, size, f2, f2ty) when
| StripLambdaValue (lambdaId, arities, size, f2, isCrossAssembly, f2ty) when
(// Considering inlining lambda
cenv.optimizing &&
cenv.settings.InlineLambdas () &&
Expand Down Expand Up @@ -2948,7 +2961,8 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m)

// Inlining lambda
(* ---------- printf "Inlining lambda near %a = %s\n" outputRange m (showL (exprL f2)) (* JAMES: *) ----------*)
let f2R = remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated f2)
let f2R = CopyExprForInlining cenv isCrossAssembly f2 m

// Optimizing arguments after inlining

// REVIEW: this is a cheapshot way of optimizing the arg expressions as well without the restriction of recursive
Expand All @@ -2962,6 +2976,16 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m)

| _ -> None

/// When optimizing a function in an application, use the whole range including arguments for the range
/// to apply to 'inline' code
and OptimizeFuncInApplication cenv env f0 mWithArgs =
let f0 = stripExpr f0
match f0 with
| Expr.Val (v, _vFlags, _) ->
OptimizeVal cenv env f0 (v, mWithArgs)
| _ ->
OptimizeExpr cenv env f0

/// Optimize/analyze an application of a function to type and term arguments
and OptimizeApplication cenv env (f0, f0ty, tyargs, args, m) =
// trying to devirtualize
Expand All @@ -2970,7 +2994,7 @@ and OptimizeApplication cenv env (f0, f0ty, tyargs, args, m) =
// devirtualized
res
| None ->
let newf0, finfo = OptimizeExpr cenv env f0
let newf0, finfo = OptimizeFuncInApplication cenv env f0 m
match TryInlineApplication cenv env finfo (tyargs, args, m) with
| Some res ->
// inlined
Expand Down Expand Up @@ -3086,14 +3110,14 @@ and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety =
// can't inline any values with semi-recursive object references to self or base
let valu =
match baseValOpt with
| None -> CurriedLambdaValue (lambdaId, arities, bsize, exprR, ety)
| None -> CurriedLambdaValue (lambdaId, arities, bsize, exprR, false, ety)
| Some baseVal ->
let fvs = freeInExpr CollectLocals bodyR
if fvs.UsesMethodLocalConstructs || fvs.FreeLocals.Contains baseVal then
UnknownValue
else
let expr2 = mkMemberLambdas m tps ctorThisValOpt None vsl (bodyR, bodyty)
CurriedLambdaValue (lambdaId, arities, bsize, expr2, ety)
CurriedLambdaValue (lambdaId, arities, bsize, expr2, false, ety)

let estimatedSize =
match vspec with
Expand Down Expand Up @@ -3323,7 +3347,7 @@ and OptimizeBinding cenv isRec env (TBind(vref, expr, spBind)) =
// Trim out optimization information for expressions that call protected members
let rec cut ivalue =
match ivalue with
| CurriedLambdaValue (_, arities, size, body, _) ->
| CurriedLambdaValue (_, arities, size, body, _, _) ->
if size > (cenv.settings.lambdaInlineThreshold + arities + 2) then
// Discarding lambda for large binding
UnknownValue
Expand Down Expand Up @@ -3600,7 +3624,7 @@ let rec p_ExprValueInfo x st =
| UnionCaseValue (a, b) ->
p_byte 4 st
p_tup2 p_ucref (p_array p_ExprValueInfo) (a, b) st
| CurriedLambdaValue (_, b, c, d, e) ->
| CurriedLambdaValue (_, b, c, d, _isCrossAssembly, e) ->
p_byte 5 st
p_tup4 p_int p_int p_expr p_ty (b, c, d, e) st
| ConstExprValue (a, b) ->
Expand Down Expand Up @@ -3635,11 +3659,12 @@ let rec u_ExprInfo st =
| 2 -> u_tup2 u_vref loop st |> (fun (a, b) -> ValValue (a, b))
| 3 -> u_array loop st |> (fun a -> TupleValue a)
| 4 -> u_tup2 u_ucref (u_array loop) st |> (fun (a, b) -> UnionCaseValue (a, b))
| 5 -> u_tup4 u_int u_int u_expr u_ty st |> (fun (b, c, d, e) -> CurriedLambdaValue (newUnique(), b, c, d, e))
| 5 -> u_tup4 u_int u_int u_expr u_ty st |> (fun (b, c, d, e) -> CurriedLambdaValue (newUnique(), b, c, d, (* isCrossAssembly *) true, e))
| 6 -> u_tup2 u_int u_expr st |> (fun (a, b) -> ConstExprValue (a, b))
| 7 -> u_tup2 u_tcref (u_array loop) st |> (fun (a, b) -> RecdValue (a, b))
| _ -> failwith "loop"
MakeSizedValueInfo (loop st) (* calc size of unpicked ExprValueInfo *)
// calc size of unpicked ExprValueInfo
MakeSizedValueInfo (loop st)

and u_ValInfo st =
let a, b = u_tup2 u_ExprInfo u_bool st
Expand Down
2 changes: 1 addition & 1 deletion src/fsharp/TypedTreeOps.fs
Original file line number Diff line number Diff line change
Expand Up @@ -7539,7 +7539,7 @@ let rec MakeApplicationAndBetaReduceAux g (f, fty, tyargsl: TType list list, arg
match f with
| Expr.TyLambda (_, tyvs, body, _, bodyty) when tyvs.Length = List.length tyargs ->
let tpenv = bindTypars tyvs tyargs emptyTyparInst
let body = remarkExpr m (instExpr g tpenv body)
let body = instExpr g tpenv body
let bodyty' = instType tpenv bodyty
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What was the remarkExpr doing before?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

"mark" is an old name for "range" so "remarkExpr" means "re-range expression" meaning replacing the ranges with one specific range. We use the same routine to make some other changes too (locals to compiler generated), and it is always run for inline code.

In the above line, we were needlessly and incorrectly calling "remarkExpr" even when doing simple reduction on applying generic functions (e.g. when optimizing let id x = x in id 3 - here id is generic and the optimizer decides to inline it). We shouldn't be remarking the body of id here. For example consider

let f () = 
    let id x =
        printfn "hello"
        printfn "hello"
        x
    id 3 + id 7

The debug points for the printfn shouldn't disappear in Release code just because id gets inlined (that's assuming it does actually get inlined)

MakeApplicationAndBetaReduceAux g (body, bodyty', rest, argsl, m)

Expand Down
2 changes: 1 addition & 1 deletion tests/fsharp/typecheck/sigs/neg117.bsl
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@

neg117.fs(79,18,79,59): ilxgen error FS0041: No overloads match for method 'Transform'.
neg117.fs(74,51,74,121): ilxgen error FS0041: No overloads match for method 'Transform'.
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This change in error location is acceptable. This is a late last-minute check from IlxGen based on inline code which now reports a different range. The error should really be reported during type checking, or the code generation succeed.


Known return type: ('a -> Neg117.TargetA.M1 Microsoft.FSharp.Core.[])

Expand Down
6 changes: 4 additions & 2 deletions tests/fsharpqa/Source/CodeGen/EmittedIL/CompareIL.cmd
Original file line number Diff line number Diff line change
@@ -1,15 +1,17 @@
REM == %1 --> assembly

ildasm /TEXT /LINENUM /NOBAR "%~nx1" >"%~n1.il"
IF NOT ERRORLEVEL 0 exit 1
IF %ERRORLEVEL% NEQ 0 exit /b 1

echo %~dp0..\..\..\testenv\bin\ILComparer.exe "%~n1.il.bsl" "%~n1.il"
%~dp0..\..\..\testenv\bin\ILComparer.exe "%~n1.il.bsl" "%~n1.il"

IF %ERRORLEVEL% EQU 0 exit /b 0

if /i "%TEST_UPDATE_BSL%" == "1" (
echo copy /y "%~n1.il" "%~n1.il.bsl"
copy /y "%~n1.il" "%~n1.il.bsl"
)

exit /b %ERRORLEVEL%
exit /b 1

Original file line number Diff line number Diff line change
Expand Up @@ -50,13 +50,13 @@
// Offset: 0x00000408 Length: 0x00000129
}
.module Linq101Grouping01.exe
// MVID: {60B78A59-FB79-E5BF-A745-0383598AB760}
// MVID: {60D46F1F-FB79-E5BF-A745-03831F6FD460}
.imagebase 0x00400000
.file alignment 0x00000200
.stackreserve 0x00100000
.subsystem 0x0003 // WINDOWS_CUI
.corflags 0x00000001 // ILONLY
// Image base: 0x06730000
// Image base: 0x05800000


// =============== CLASS MEMBERS DECLARATION ===================
Expand Down Expand Up @@ -371,7 +371,7 @@
{
// Code size 8 (0x8)
.maxstack 8
.line 25,25 : 24,25 ''
.line 25,25 : 23,28 ''
IL_0000: ldarg.1
IL_0001: ldc.i4.0
IL_0002: callvirt instance char [netstandard]System.String::get_Chars(int32)
Expand Down
Loading