Skip to content

Commit

Permalink
Fix some debug glitches (#11981)
Browse files Browse the repository at this point in the history 
* trial breakpoints on pipelines

* trial breakpoints on pipelines

* trial breakpoints on pipelines

* increment pipeline number

* upddate baselines and fix bug with then-do expressions

* support for ||> and ||>

* fix ||> and |||>

* add input numbers

* add input numbers

* add codgen for ||> and ||>

* Update src/fsharp/Optimizer.fs

Co-authored-by: Hadrian Tang <hadrianwttang@outlook.com>

* add VBPL tests

* include line number

* debug points on when

* correct initial debug point of methods

* rename

* cleanup

* IL updates

* update baselines

* don't try to activate test as part of this PR

* add test

* update baseline

* update baseline

* fixes and abseline updates and more testing

Co-authored-by: Don Syme <donsyme@fastmail.com>
Co-authored-by: Hadrian Tang <hadrianwttang@outlook.com>
  • Loading branch information
@dsyme @Happypig375
3 people authored Aug 18, 2021
1 parent 9d92884 commit ac2ce91
Show file tree
Hide file tree
Showing 127 changed files with 9,940 additions and 8,686 deletions.
56 changes: 28 additions & 28 deletions src/fsharp/AugmentWithHashCompare.fs
View file
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
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

0 comments on commit ac2ce91

Please sign in to comment.