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.

Sign up for GitHub

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

Fix some debug glitches #11981

Merged
merged 34 commits into from
Aug 18, 2021
Merged

Fix some debug glitches #11981

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
34 commits
Select commit Hold shift + click to select a range
7204c31
trial breakpoints on pipelines
Aug 12, 2021
26fb892
Merge branch 'main' of https://github.com/dotnet/fsharp into bp5
Aug 12, 2021
8ca9c5a
trial breakpoints on pipelines
Aug 12, 2021
fd39288
trial breakpoints on pipelines
Aug 12, 2021
97fc104
Merge branch 'main' of https://github.com/dotnet/fsharp into bp5
Aug 12, 2021
fb75858
increment pipeline number
Aug 13, 2021
da4716e
Merge branch 'main' of https://github.com/dotnet/fsharp into bp5
Aug 13, 2021
235d3f7
upddate baselines and fix bug with then-do expressions
Aug 13, 2021
d39b54c
support for ||> and ||>
Aug 13, 2021
bc98121
fix ||> and |||>
Aug 13, 2021
cf384ac
add input numbers
Aug 13, 2021
5383d64
add input numbers
Aug 13, 2021
7087aa5
add codgen for ||> and ||>
Aug 14, 2021
a95d6dc
Update src/fsharp/Optimizer.fs
dsyme Aug 14, 2021
e3553fa
Merge branch 'main' of https://github.com/dotnet/fsharp into bp5
Aug 14, 2021
ec25a90
add VBPL tests
Aug 14, 2021
6fc17d1
include line number
Aug 14, 2021
c563e73
debug points on when
Aug 16, 2021
1dcd70b
correct initial debug point of methods
Aug 16, 2021
9e48ca3
Merge branch 'bp5' of https://github.com/dsyme/fsharp into bp5
Aug 16, 2021
3a24e5f
Merge branch 'bp5' of https://github.com/dsyme/fsharp into bp6
Aug 16, 2021
e086697
rename
Aug 16, 2021
31a71a5
cleanup
Aug 17, 2021
4b12f8a
IL updates
Aug 17, 2021
bea8a1b
Merge branch 'bp5' of https://github.com/dsyme/fsharp into bp6
Aug 17, 2021
3b49d76
update baselines
Aug 17, 2021
24b5ee0
don't try to activate test as part of this PR
Aug 17, 2021
74d48e9
Merge branch 'bp5' of https://github.com/dsyme/fsharp into bp6
Aug 17, 2021
a5e19b5
add test
Aug 17, 2021
99de813
update baseline
Aug 17, 2021
e36d245
merge main
Aug 17, 2021
92f67fa
update baseline
Aug 17, 2021
26cc478
Merge branch 'main' of https://github.com/dotnet/fsharp into bp6
Aug 17, 2021
88e930a
fixes and abseline updates and more testing
Aug 18, 2021
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
56 changes: 28 additions & 28 deletions src/fsharp/AugmentWithHashCompare.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -157,10 +157,10 @@ let mkCompareTestConjuncts g m exprs =
(a, b) ||> List.foldBack (fun e acc ->
let nv, ne = mkCompGenLocal m "n" g.int_ty
mkCompGenLet m nv e
(mkCond DebugPointAtBinding.NoneAtSticky DebugPointForTarget.No m g.int_ty
(mkCond DebugPointAtBinding.NoneAtSticky DebugPointAtTarget.No m g.int_ty
(mkClt g m ne (mkZero g m))
ne
(mkCond DebugPointAtBinding.NoneAtSticky DebugPointForTarget.No m g.int_ty
(mkCond DebugPointAtBinding.NoneAtSticky DebugPointAtTarget.No m g.int_ty
(mkCgt g m ne (mkZero g m))
ne
acc)))
Expand All @@ -171,7 +171,7 @@ let mkEqualsTestConjuncts g m exprs =
| [h] -> h
| l ->
let a, b = List.frontAndBack l
List.foldBack (fun e acc -> mkCond DebugPointAtBinding.NoneAtSticky DebugPointForTarget.No m g.bool_ty e acc (mkFalse g m)) a b
List.foldBack (fun e acc -> mkCond DebugPointAtBinding.NoneAtSticky DebugPointAtTarget.No m g.bool_ty e acc (mkFalse g m)) a b

let mkMinimalTy (g: TcGlobals) (tcref: TyconRef) =
if tcref.Deref.IsExceptionDecl then [], g.exn_ty
Expand Down Expand Up @@ -303,9 +303,9 @@ let mkExnEquality (g: TcGlobals) exnref (exnc: Tycon) =
let mbuilder = MatchBuilder(DebugPointAtBinding.NoneAtInvisible, m )
let cases =
[ mkCase(DecisionTreeTest.IsInst(g.exn_ty, mkAppTy exnref []),
mbuilder.AddResultTarget(expr, DebugPointForTarget.No)) ]
let dflt = Some(mbuilder.AddResultTarget(mkFalse g m, DebugPointForTarget.No))
let dtree = TDSwitch(thate, cases, dflt, m)
mbuilder.AddResultTarget(expr, DebugPointAtTarget.No)) ]
let dflt = Some(mbuilder.AddResultTarget(mkFalse g m, DebugPointAtTarget.No))
let dtree = TDSwitch(DebugPointAtSwitch.No, thate, cases, dflt, m)
mbuilder.Close(dtree, m, g.bool_ty)

let expr = mkBindThatNullEquals g m thise thate expr
Expand All @@ -326,9 +326,9 @@ let mkExnEqualityWithComparer g exnref (exnc: Tycon) (_thisv, thise) thatobje (t
let mbuilder = MatchBuilder(DebugPointAtBinding.NoneAtInvisible, m )
let cases =
[ mkCase(DecisionTreeTest.IsInst(g.exn_ty, mkAppTy exnref []),
mbuilder.AddResultTarget(expr, DebugPointForTarget.No)) ]
let dflt = mbuilder.AddResultTarget(mkFalse g m, DebugPointForTarget.No)
let dtree = TDSwitch(thate, cases, Some dflt, m)
mbuilder.AddResultTarget(expr, DebugPointAtTarget.No)) ]
let dflt = mbuilder.AddResultTarget(mkFalse g m, DebugPointAtTarget.No)
let dtree = TDSwitch(DebugPointAtSwitch.No, thate, cases, Some dflt, m)
mbuilder.Close(dtree, m, g.bool_ty)
let expr = mkBindThatAddr g m g.exn_ty thataddrv thatv thate expr
let expr = mkIsInstConditional g m g.exn_ty thatobje thatv expr (mkFalse g m)
Expand Down Expand Up @@ -366,19 +366,19 @@ let mkUnionCompare g tcref (tycon: Tycon) =
mkCompGenLet m thisucv (mkUnionCaseProof (thise, cref, tinst, m))
(mkCompGenLet m thatucv (mkUnionCaseProof (thataddre, cref, tinst, m))
(mkCompareTestConjuncts g m (List.mapi (mkTest thisucve thatucve) rfields)))
Some (mkCase(DecisionTreeTest.UnionCase(cref, tinst), mbuilder.AddResultTarget(test, DebugPointForTarget.No)))
Some (mkCase(DecisionTreeTest.UnionCase(cref, tinst), mbuilder.AddResultTarget(test, DebugPointAtTarget.No)))

let nullary, nonNullary = List.partition Option.isNone (List.map mkCase ucases)
if isNil nonNullary then mkZero g m else
let cases = nonNullary |> List.map (function Some c -> c | None -> failwith "mkUnionCompare")
let dflt = if isNil nullary then None else Some (mbuilder.AddResultTarget(mkZero g m, DebugPointForTarget.No))
let dtree = TDSwitch(thise, cases, dflt, m)
let dflt = if isNil nullary then None else Some (mbuilder.AddResultTarget(mkZero g m, DebugPointAtTarget.No))
let dtree = TDSwitch(DebugPointAtSwitch.No, thise, cases, dflt, m)
mbuilder.Close(dtree, m, g.int_ty)

let expr =
if ucases.Length = 1 then expr else
let tagsEqTested =
mkCond DebugPointAtBinding.NoneAtSticky DebugPointForTarget.No m g.int_ty
mkCond DebugPointAtBinding.NoneAtSticky DebugPointAtTarget.No m g.int_ty
(mkILAsmCeq g m thistage thattage)
expr
(mkAsmExpr ([ AI_sub ], [], [thistage; thattage], [g.int_ty], m))in
Expand Down Expand Up @@ -427,19 +427,19 @@ let mkUnionCompareWithComparer g tcref (tycon: Tycon) (_thisv, thise) (_thatobjv
(mkCompGenLet m thatucv (mkUnionCaseProof (thataddre, cref, tinst, m))
(mkCompareTestConjuncts g m (List.mapi (mkTest thisucve thatucve) rfields)))

Some (mkCase(DecisionTreeTest.UnionCase(cref, tinst), mbuilder.AddResultTarget(test, DebugPointForTarget.No)))
Some (mkCase(DecisionTreeTest.UnionCase(cref, tinst), mbuilder.AddResultTarget(test, DebugPointAtTarget.No)))

let nullary, nonNullary = List.partition Option.isNone (List.map mkCase ucases)
if isNil nonNullary then mkZero g m else
let cases = nonNullary |> List.map (function Some c -> c | None -> failwith "mkUnionCompare")
let dflt = if isNil nullary then None else Some (mbuilder.AddResultTarget(mkZero g m, DebugPointForTarget.No))
let dtree = TDSwitch(thise, cases, dflt, m)
let dflt = if isNil nullary then None else Some (mbuilder.AddResultTarget(mkZero g m, DebugPointAtTarget.No))
let dtree = TDSwitch(DebugPointAtSwitch.No, thise, cases, dflt, m)
mbuilder.Close(dtree, m, g.int_ty)

let expr =
if ucases.Length = 1 then expr else
let tagsEqTested =
mkCond DebugPointAtBinding.NoneAtSticky DebugPointForTarget.No m g.int_ty
mkCond DebugPointAtBinding.NoneAtSticky DebugPointAtTarget.No m g.int_ty
(mkILAsmCeq g m thistage thattage)
expr
(mkAsmExpr ([ AI_sub ], [], [thistage; thattage], [g.int_ty], m))
Expand Down Expand Up @@ -487,19 +487,19 @@ let mkUnionEquality g tcref (tycon: Tycon) =
(mkCompGenLet m thatucv (mkUnionCaseProof (thataddre, cref, tinst, m))
(mkEqualsTestConjuncts g m (List.mapi (mkTest thisucve thatucve) rfields)))

Some (mkCase(DecisionTreeTest.UnionCase(cref, tinst), mbuilder.AddResultTarget(test, DebugPointForTarget.No)))
Some (mkCase(DecisionTreeTest.UnionCase(cref, tinst), mbuilder.AddResultTarget(test, DebugPointAtTarget.No)))

let nullary, nonNullary = List.partition Option.isNone (List.map mkCase ucases)
if isNil nonNullary then mkTrue g m else
let cases = List.map (function Some c -> c | None -> failwith "mkUnionEquality") nonNullary
let dflt = (if isNil nullary then None else Some (mbuilder.AddResultTarget(mkTrue g m, DebugPointForTarget.No)))
let dtree = TDSwitch(thise, cases, dflt, m)
let dflt = (if isNil nullary then None else Some (mbuilder.AddResultTarget(mkTrue g m, DebugPointAtTarget.No)))
let dtree = TDSwitch(DebugPointAtSwitch.No, thise, cases, dflt, m)
mbuilder.Close(dtree, m, g.bool_ty)

let expr =
if ucases.Length = 1 then expr else
let tagsEqTested =
mkCond DebugPointAtBinding.NoneAtSticky DebugPointForTarget.No m g.bool_ty
mkCond DebugPointAtBinding.NoneAtSticky DebugPointAtTarget.No m g.bool_ty
(mkILAsmCeq g m thistage thattage)
expr
(mkFalse g m)
Expand Down Expand Up @@ -549,19 +549,19 @@ let mkUnionEqualityWithComparer g tcref (tycon: Tycon) (_thisv, thise) thatobje
(mkCompGenLet m thatucv (mkUnionCaseProof (thataddre, cref, tinst, m))
(mkEqualsTestConjuncts g m (List.mapi (mkTest thisucve thatucve) rfields)))

Some (mkCase(DecisionTreeTest.UnionCase(cref, tinst), mbuilder.AddResultTarget (test, DebugPointForTarget.No)))
Some (mkCase(DecisionTreeTest.UnionCase(cref, tinst), mbuilder.AddResultTarget (test, DebugPointAtTarget.No)))

let nullary, nonNullary = List.partition Option.isNone (List.map mkCase ucases)
if isNil nonNullary then mkTrue g m else
let cases = List.map (function Some c -> c | None -> failwith "mkUnionEquality") nonNullary
let dflt = if isNil nullary then None else Some (mbuilder.AddResultTarget(mkTrue g m, DebugPointForTarget.No))
let dtree = TDSwitch(thise, cases, dflt, m)
let dflt = if isNil nullary then None else Some (mbuilder.AddResultTarget(mkTrue g m, DebugPointAtTarget.No))
let dtree = TDSwitch(DebugPointAtSwitch.No, thise, cases, dflt, m)
mbuilder.Close(dtree, m, g.bool_ty)

let expr =
if ucases.Length = 1 then expr else
let tagsEqTested =
mkCond DebugPointAtBinding.NoneAtSticky DebugPointForTarget.No m g.bool_ty
mkCond DebugPointAtBinding.NoneAtSticky DebugPointAtTarget.No m g.bool_ty
(mkILAsmCeq g m thistage thattage)
expr
(mkFalse g m)
Expand Down Expand Up @@ -648,7 +648,7 @@ let mkUnionHashWithComparer g tcref (tycon: Tycon) compe =
(mkCompGenSequential m
(mkValSet m (mkLocalValRef accv) (mkInt g m i))
(mkCombineHashGenerators g m (List.mapi (mkHash ucve) ucase1.RecdFields) (mkLocalValRef accv) acce))
Some(mkCase(DecisionTreeTest.UnionCase(c1ref, tinst), mbuilder.AddResultTarget(test, DebugPointForTarget.No)))
Some(mkCase(DecisionTreeTest.UnionCase(c1ref, tinst), mbuilder.AddResultTarget(test, DebugPointAtTarget.No)))

let nullary, nonNullary = ucases
|> List.mapi mkCase
Expand All @@ -657,8 +657,8 @@ let mkUnionHashWithComparer g tcref (tycon: Tycon) compe =
let dflt = if isNil nullary then None
else
let tag = mkUnionCaseTagGetViaExprAddr (thise, tcref, tinst, m)
Some(mbuilder.AddResultTarget(tag, DebugPointForTarget.No))
let dtree = TDSwitch(thise, cases, dflt, m)
Some(mbuilder.AddResultTarget(tag, DebugPointAtTarget.No))
let dtree = TDSwitch(DebugPointAtSwitch.No, thise, cases, dflt, m)
let stmt = mbuilder.Close(dtree, m, g.int_ty)
let expr = mkCompGenLet m accv (mkZero g m) stmt
let expr = if tycon.IsStructOrEnumTycon then expr else mkBindNullHash g m thise expr
Expand Down
16 changes: 8 additions & 8 deletions src/fsharp/CheckComputationExpressions.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -945,7 +945,7 @@ let TcComputationExpression cenv env (overallTy: OverallTy) tpenv (mWhole, inter

Some (trans CompExprTranslationPass.Initial q varSpace innerComp
(fun holeFill ->
translatedCtxt (mkSynCall "For" mFor [wrappedSourceExpr; SynExpr.MatchLambda (false, sourceExpr.Range, [SynMatchClause(pat, None, None, holeFill, mPat, DebugPointForTarget.Yes)], spBind, mFor) ])) )
translatedCtxt (mkSynCall "For" mFor [wrappedSourceExpr; SynExpr.MatchLambda (false, sourceExpr.Range, [SynMatchClause(pat, None, None, holeFill, mPat, DebugPointAtTarget.Yes)], spBind, mFor) ])) )

| SynExpr.For (spBind, id, start, dir, finish, innerComp, m) ->
let mFor = match spBind with DebugPointAtFor.Yes m -> m.NoteDebugPoint(RangeDebugPointKind.For) | _ -> m
Expand Down Expand Up @@ -1119,7 +1119,7 @@ let TcComputationExpression cenv env (overallTy: OverallTy) tpenv (mWhole, inter
let bindRange = match spBind with DebugPointAtBinding.Yes m -> m | _ -> rhsExpr.Range
if isQuery then error(Error(FSComp.SR.tcUseMayNotBeUsedInQueries(), bindRange))
let innerCompRange = innerComp.Range
let consumeExpr = SynExpr.MatchLambda(false, innerCompRange, [SynMatchClause(pat, None, None, transNoQueryOps innerComp, innerCompRange, DebugPointForTarget.Yes)], spBind, innerCompRange)
let consumeExpr = SynExpr.MatchLambda(false, innerCompRange, [SynMatchClause(pat, None, None, transNoQueryOps innerComp, innerCompRange, DebugPointAtTarget.Yes)], spBind, innerCompRange)
if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad "Using" builderTy) then
error(Error(FSComp.SR.tcRequireBuilderMethod("Using"), bindRange))
Some (translatedCtxt (mkSynCall "Using" bindRange [rhsExpr; consumeExpr ]))
Expand Down Expand Up @@ -1155,9 +1155,9 @@ let TcComputationExpression cenv env (overallTy: OverallTy) tpenv (mWhole, inter
if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad "Bind" builderTy) then
error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"), bindRange))

let consumeExpr = SynExpr.MatchLambda(false, bindRange, [SynMatchClause(pat, None, None, transNoQueryOps innerComp, innerComp.Range, DebugPointForTarget.Yes)], spBind, bindRange)
let consumeExpr = SynExpr.MatchLambda(false, bindRange, [SynMatchClause(pat, None, None, transNoQueryOps innerComp, innerComp.Range, DebugPointAtTarget.Yes)], spBind, bindRange)
let consumeExpr = mkSynCall "Using" bindRange [SynExpr.Ident(id); consumeExpr ]
let consumeExpr = SynExpr.MatchLambda(false, bindRange, [SynMatchClause(pat, None, None, consumeExpr, id.idRange, DebugPointForTarget.Yes)], spBind, bindRange)
let consumeExpr = SynExpr.MatchLambda(false, bindRange, [SynMatchClause(pat, None, None, consumeExpr, id.idRange, DebugPointAtTarget.Yes)], spBind, bindRange)
let rhsExpr = mkSourceExprConditional isFromSource rhsExpr
// TODO: consider allowing translation to BindReturn
Some(translatedCtxt (mkSynCall "Bind" bindRange [rhsExpr; consumeExpr]))
Expand Down Expand Up @@ -1510,7 +1510,7 @@ let TcComputationExpression cenv env (overallTy: OverallTy) tpenv (mWhole, inter

// Build the `BindReturn` call
let dataCompPriorToOp =
let consumeExpr = SynExpr.MatchLambda(false, consumePat.Range, [SynMatchClause(consumePat, None, None, innerExpr, innerRange, DebugPointForTarget.Yes)], spBind, innerRange)
let consumeExpr = SynExpr.MatchLambda(false, consumePat.Range, [SynMatchClause(consumePat, None, None, innerExpr, innerRange, DebugPointAtTarget.Yes)], spBind, innerRange)
translatedCtxt (mkSynCall bindName bindRange (bindArgs @ [consumeExpr]))

match customOpInfo with
Expand All @@ -1526,7 +1526,7 @@ let TcComputationExpression cenv env (overallTy: OverallTy) tpenv (mWhole, inter

// Build the `Bind` call
trans CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill ->
let consumeExpr = SynExpr.MatchLambda(false, consumePat.Range, [SynMatchClause(consumePat, None, None, holeFill, innerRange, DebugPointForTarget.Yes)], spBind, innerRange)
let consumeExpr = SynExpr.MatchLambda(false, consumePat.Range, [SynMatchClause(consumePat, None, None, holeFill, innerRange, DebugPointAtTarget.Yes)], spBind, innerRange)
translatedCtxt (mkSynCall bindName bindRange (bindArgs @ [consumeExpr])))

and convertSimpleReturnToExpr varSpace innerComp =
Expand Down Expand Up @@ -1692,7 +1692,7 @@ let mkSeqFinally (cenv: cenv) env m genTy e1 e2 =
mkCallSeqFinally cenv.g m genResultTy e1 e2

let mkSeqExprMatchClauses (pat', vspecs) innerExpr =
[TClause(pat', None, TTarget(vspecs, innerExpr, DebugPointForTarget.Yes, None), pat'.Range) ]
[TClause(pat', None, TTarget(vspecs, innerExpr, DebugPointAtTarget.Yes, None), pat'.Range) ]

let compileSeqExprMatchClauses (cenv: cenv) env inputExprMark (pat: Pattern, vspecs) innerExpr inputExprOpt bindPatTy genInnerTy =
let patMark = pat.Range
Expand Down Expand Up @@ -1828,7 +1828,7 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m =
let thenExpr, tpenv = tcSequenceExprBody env genOuterTy tpenv thenComp
let elseComp = (match elseCompOpt with Some c -> c | None -> SynExpr.ImplicitZero mIfToThen)
let elseExpr, tpenv = tcSequenceExprBody env genOuterTy tpenv elseComp
Some(mkCond spIfToThen DebugPointForTarget.Yes mIfToEndOfElseBranch genOuterTy guardExpr' thenExpr elseExpr, tpenv)
Some(mkCond spIfToThen DebugPointAtTarget.Yes mIfToEndOfElseBranch genOuterTy guardExpr' thenExpr elseExpr, tpenv)

// 'let x = expr in expr'
| SynExpr.LetOrUse (_, false (* not a 'use' binding *), _, _, _) ->
Expand Down
Loading