Skip to content

Commit b5a9996

Browse files
TIHanTIHan
committed
Pure CPS
1 parent b663ffc commit b5a9996

File tree

1 file changed

+45
-53
lines changed

1 file changed

+45
-53
lines changed

‎src/fsharp/IlxGen.fs‎

Lines changed: 45 additions & 53 deletions
Original file line numberDiff line numberDiff line change
@@ -4840,6 +4840,16 @@ and GenJoinPoint cenv cgbuf pos eenv ty m sequel =
48404840
// go to the join point
48414841
Br afterJoin, afterJoin, stackAfterJoin, sequel
48424842

4843+
// Accumulate the decision graph as we go
4844+
and GenDecisionTreeAndTargets cenv cgbuf stackAtTargets eenv tree targets repeatSP sequel contf =
4845+
GenDecisionTreeAndTargetsInner cenv cgbuf None stackAtTargets eenv tree targets repeatSP (IntMap.empty()) sequel (fun targetInfos ->
4846+
let sortedTargetInfos =
4847+
targetInfos
4848+
|> Seq.sortBy (fun (KeyValue(targetIdx, _)) -> targetIdx)
4849+
|> List.ofSeq
4850+
GenPostponedDecisionTreeTargets cenv cgbuf sortedTargetInfos stackAtTargets sequel contf
4851+
)
4852+
48434853
and GenPostponedDecisionTreeTargets cenv cgbuf targetInfos stackAtTargets sequel contf =
48444854
match targetInfos with
48454855
| [] -> contf Fake
@@ -4852,35 +4862,6 @@ and GenPostponedDecisionTreeTargets cenv cgbuf targetInfos stackAtTargets sequel
48524862
else
48534863
GenPostponedDecisionTreeTargets cenv cgbuf rest stackAtTargets sequel contf
48544864

4855-
and GenDecisionTreesAndTargets cenv cgbuf targetInfos decisions stackAtTargets targets repeatSP sequel contf =
4856-
match decisions with
4857-
| [] ->
4858-
let sortedTargetInfos =
4859-
targetInfos
4860-
|> Seq.sortBy (fun (KeyValue(targetIdx, _)) -> targetIdx)
4861-
|> List.ofSeq
4862-
4863-
GenPostponedDecisionTreeTargets cenv cgbuf sortedTargetInfos stackAtTargets sequel contf
4864-
4865-
| (inplabOpt, eenv, tree) :: rest ->
4866-
match tree with
4867-
| TDSuccess(es, targetIdx) ->
4868-
let targetInfos, genTargetInfoOpt = GenDecisionTreeSuccess cenv cgbuf inplabOpt stackAtTargets eenv es targetIdx targets repeatSP targetInfos sequel
4869-
match genTargetInfoOpt with
4870-
| Some (eenvAtTarget, spExprAtTarget, exprAtTarget, sequelAtTarget) ->
4871-
GenLinearExpr cenv cgbuf eenvAtTarget spExprAtTarget exprAtTarget sequelAtTarget true (fun Fake ->
4872-
GenDecisionTreesAndTargets cenv cgbuf targetInfos rest stackAtTargets targets repeatSP sequel contf
4873-
)
4874-
| _ ->
4875-
GenDecisionTreesAndTargets cenv cgbuf targetInfos rest stackAtTargets targets repeatSP sequel contf
4876-
| _ ->
4877-
let newDecisions = GenDecisionTreeAndTargetsInner cenv cgbuf inplabOpt stackAtTargets eenv tree targets repeatSP targetInfos sequel
4878-
GenDecisionTreesAndTargets cenv cgbuf targetInfos (newDecisions @ rest) stackAtTargets targets repeatSP sequel contf
4879-
4880-
// Accumulate the decision graph as we go
4881-
and GenDecisionTreeAndTargets cenv cgbuf stackAtTargets eenv tree targets repeatSP sequel contf =
4882-
GenDecisionTreesAndTargets cenv cgbuf (IntMap.empty()) [(None, eenv, tree)] stackAtTargets targets repeatSP sequel contf
4883-
48844865
and TryFindTargetInfo targetInfos n =
48854866
match IntMap.tryFind n targetInfos with
48864867
| Some (targetInfo, _) -> Some targetInfo
@@ -4890,7 +4871,7 @@ and TryFindTargetInfo targetInfos n =
48904871
///
48914872
/// When inplabOpt is "Some inplab", we are assuming an existing branch to "inplab" and can optionally
48924873
/// set inplab to point to another location if no codegen is required.
4893-
and GenDecisionTreeAndTargetsInner cenv cgbuf inplabOpt stackAtTargets eenv tree targets repeatSP targetInfos sequel =
4874+
and GenDecisionTreeAndTargetsInner cenv cgbuf inplabOpt stackAtTargets eenv tree targets repeatSP targetInfos sequel (contf: Zmap<_,_> -> FakeUnit) =
48944875
CG.SetStack cgbuf stackAtTargets // Set the expected initial stack.
48954876
match tree with
48964877
| TDBind(bind, rest) ->
@@ -4903,13 +4884,18 @@ and GenDecisionTreeAndTargetsInner cenv cgbuf inplabOpt stackAtTargets eenv tree
49034884
// we effectively lose an EndLocalScope for all dtrees that go to the same target
49044885
// So we just pretend that the variable goes out of scope here.
49054886
CG.SetMarkToHere cgbuf endScope
4906-
GenDecisionTreeAndTargetsInner cenv cgbuf None stackAtTargets eenv rest targets repeatSP targetInfos sequel
4887+
GenDecisionTreeAndTargetsInner cenv cgbuf None stackAtTargets eenv rest targets repeatSP targetInfos sequel contf
49074888

4908-
| TDSuccess _ ->
4909-
[(inplabOpt, eenv, tree)]
4889+
| TDSuccess(es, targetIdx) ->
4890+
let targetInfos, genTargetInfoOpt = GenDecisionTreeSuccess cenv cgbuf inplabOpt stackAtTargets eenv es targetIdx targets repeatSP targetInfos sequel
4891+
match genTargetInfoOpt with
4892+
| Some (eenvAtTarget, spExprAtTarget, exprAtTarget, sequelAtTarget) ->
4893+
GenLinearExpr cenv cgbuf eenvAtTarget spExprAtTarget exprAtTarget sequelAtTarget true (fun Fake -> contf targetInfos)
4894+
| _ ->
4895+
contf targetInfos
49104896

49114897
| TDSwitch(e, cases, dflt, m) ->
4912-
GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases dflt m targets repeatSP sequel
4898+
GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases dflt m targets repeatSP targetInfos sequel contf
49134899

49144900
and GetTarget (targets:_[]) n =
49154901
if n >= targets.Length then failwith "GetTarget: target not found in decision tree"
@@ -4983,7 +4969,7 @@ and GenDecisionTreeTarget cenv cgbuf stackAtTargets (targetMarkBeforeBinds, targ
49834969
CG.SetStack cgbuf stackAtTargets
49844970
(eenvAtTarget, spExpr, successExpr, (EndLocalScope(sequel, endScope)))
49854971

4986-
and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defaultTargetOpt switchm targets repeatSP sequel =
4972+
and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defaultTargetOpt switchm targets repeatSP targetInfos sequel contf =
49874973
let g = cenv.g
49884974
let m = e.Range
49894975
match inplabOpt with None -> () | Some inplab -> CG.SetMarkToHere cgbuf inplab
@@ -4993,7 +4979,7 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau
49934979
// optimize a test against a boolean value, i.e. the all-important if-then-else
49944980
| TCase(DecisionTreeTest.Const(Const.Bool b), successTree) :: _ ->
49954981
let failureTree = (match defaultTargetOpt with None -> cases.Tail.Head.CaseTree | Some d -> d)
4996-
GenDecisionTreeTest cenv eenv.cloc cgbuf e None eenv (if b then successTree else failureTree) (if b then failureTree else successTree) targets sequel
4982+
GenDecisionTreeTest cenv eenv.cloc cgbuf stackAtTargets e None eenv (if b then successTree else failureTree) (if b then failureTree else successTree) targets repeatSP targetInfos sequel contf
49974983

49984984
// // Remove a single test for a union case . Union case tests are always exa
49994985
//| [ TCase(DecisionTreeTest.UnionCase _, successTree) ] when (defaultTargetOpt.IsNone) ->
@@ -5010,7 +4996,7 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau
50104996
let cuspec = GenUnionSpec cenv.amap m eenv.tyenv c.TyconRef tyargs
50114997
let idx = c.Index
50124998
let avoidHelpers = entityRefInThisAssembly g.compilingFslib c.TyconRef
5013-
GenDecisionTreeTest cenv eenv.cloc cgbuf e (Some (pop 1, Push [g.ilg.typ_Bool], Choice1Of2 (avoidHelpers, cuspec, idx))) eenv successTree failureTree targets sequel
4999+
GenDecisionTreeTest cenv eenv.cloc cgbuf stackAtTargets e (Some (pop 1, Push [g.ilg.typ_Bool], Choice1Of2 (avoidHelpers, cuspec, idx))) eenv successTree failureTree targets repeatSP targetInfos sequel contf
50145000

50155001
| _ ->
50165002
let caseLabels = List.map (fun _ -> CG.GenerateDelayMark cgbuf "switch_case") cases
@@ -5041,7 +5027,7 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau
50415027
BI_brtrue
50425028
| _ -> failwith "internal error: GenDecisionTreeSwitch"
50435029
CG.EmitInstr cgbuf (pop 1) Push0 (I_brcmp (bi, (List.head caseLabels).CodeLabel))
5044-
GenDecisionTreeCases cgbuf stackAtTargets eenv defaultTargetOpt caseLabels cases
5030+
GenDecisionTreeCases cenv cgbuf stackAtTargets eenv defaultTargetOpt targets repeatSP targetInfos sequel caseLabels cases contf
50455031

50465032
| DecisionTreeTest.ActivePatternCase _ -> error(InternalError("internal error in codegen: DecisionTreeTest.ActivePatternCase", switchm))
50475033
| DecisionTreeTest.UnionCase (hdc, tyargs) ->
@@ -5057,7 +5043,7 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau
50575043
let avoidHelpers = entityRefInThisAssembly g.compilingFslib hdc.TyconRef
50585044
EraseUnions.emitDataSwitch g.ilg (UnionCodeGen cgbuf) (avoidHelpers, cuspec, dests)
50595045
CG.EmitInstrs cgbuf (pop 1) Push0 [ ] // push/pop to match the line above
5060-
GenDecisionTreeCases cgbuf stackAtTargets eenv defaultTargetOpt caseLabels cases
5046+
GenDecisionTreeCases cenv cgbuf stackAtTargets eenv defaultTargetOpt targets repeatSP targetInfos sequel caseLabels cases contf
50615047

50625048
| DecisionTreeTest.Const c ->
50635049
GenExpr cenv cgbuf eenv SPSuppress e Continue
@@ -5100,25 +5086,30 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau
51005086
CG.EmitInstr cgbuf (pop 1) Push0 (I_switch destinationLabels)
51015087
else
51025088
error(InternalError("non-dense integer matches not implemented in codegen - these should have been removed by the pattern match compiler", switchm))
5103-
GenDecisionTreeCases cgbuf stackAtTargets eenv defaultTargetOpt caseLabels cases
5089+
GenDecisionTreeCases cenv cgbuf stackAtTargets eenv defaultTargetOpt targets repeatSP targetInfos sequel caseLabels cases contf
51045090
| _ -> error(InternalError("these matches should never be needed", switchm))
51055091

5106-
and GenDecisionTreeCases cgbuf stackAtTargets eenv defaultTargetOpt caseLabels cases =
5092+
and GenDecisionTreeCases cenv cgbuf stackAtTargets eenv defaultTargetOpt targets repeatSP targetInfos sequel caseLabels cases (contf: Zmap<_,_> -> FakeUnit) =
51075093
assert(cgbuf.GetCurrentStack() = stackAtTargets) // cgbuf stack should be unchanged over tests. [bug://1750].
51085094

5109-
let defaultDecisions =
5110-
match defaultTargetOpt with
5111-
| Some defaultTarget -> [(None, eenv, defaultTarget)]
5112-
| None -> []
5113-
5114-
(caseLabels, cases)
5115-
||> List.map2 (fun caseLabel (TCase(_, caseTree)) -> (Some caseLabel, eenv, caseTree))
5116-
|> List.append defaultDecisions
5095+
match defaultTargetOpt with
5096+
| Some defaultTarget ->
5097+
GenDecisionTreeAndTargetsInner cenv cgbuf None stackAtTargets eenv defaultTarget targets repeatSP targetInfos sequel (fun targetInfos ->
5098+
GenDecisionTreeCases cenv cgbuf stackAtTargets eenv None targets repeatSP targetInfos sequel caseLabels cases contf
5099+
)
5100+
| None ->
5101+
match caseLabels, cases with
5102+
| caseLabel :: caseLabelsTail, (TCase(_, caseTree)) :: casesTail ->
5103+
GenDecisionTreeAndTargetsInner cenv cgbuf (Some caseLabel) stackAtTargets eenv caseTree targets repeatSP targetInfos sequel (fun targetInfos ->
5104+
GenDecisionTreeCases cenv cgbuf stackAtTargets eenv None targets repeatSP targetInfos sequel caseLabelsTail casesTail contf
5105+
)
5106+
| _ ->
5107+
contf targetInfos
51175108

51185109
// Used for the peephole optimization below
51195110
and (|BoolExpr|_|) = function Expr.Const (Const.Bool b1, _, _) -> Some b1 | _ -> None
51205111

5121-
and GenDecisionTreeTest cenv cloc cgbuf e tester eenv successTree failureTree targets sequel =
5112+
and GenDecisionTreeTest cenv cloc cgbuf stackAtTargets e tester eenv successTree failureTree targets repeatSP targetInfos sequel contf =
51225113
let g = cenv.g
51235114
match successTree, failureTree with
51245115

@@ -5145,7 +5136,7 @@ and GenDecisionTreeTest cenv cloc cgbuf e tester eenv successTree failureTree ta
51455136
CG.EmitInstrs cgbuf (pop 0) (Push [g.ilg.typ_Bool]) [mkLdcInt32 0 ]
51465137
CG.EmitInstrs cgbuf (pop 1) Push0 [AI_ceq]
51475138
GenSequel cenv cloc cgbuf sequel
5148-
[]
5139+
contf targetInfos
51495140

51505141
| _ -> failwith "internal error: GenDecisionTreeTest during bool elim"
51515142

@@ -5167,8 +5158,9 @@ and GenDecisionTreeTest cenv cloc cgbuf e tester eenv successTree failureTree ta
51675158
| Choice2Of2 i -> CG.EmitInstr cgbuf pops pushes i
51685159
CG.EmitInstr cgbuf (pop 1) Push0 (I_brcmp (BI_brfalse, failure.CodeLabel))
51695160

5170-
[ (None, eenv, successTree)
5171-
(Some failure, eenv, failureTree) ]
5161+
GenDecisionTreeAndTargetsInner cenv cgbuf None stackAtTargets eenv successTree targets repeatSP targetInfos sequel (fun targetInfos ->
5162+
GenDecisionTreeAndTargetsInner cenv cgbuf (Some failure) stackAtTargets eenv failureTree targets repeatSP targetInfos sequel contf
5163+
)
51725164

51735165
/// Generate fixups for letrec bindings
51745166
and GenLetRecFixup cenv cgbuf eenv (ilxCloSpec: IlxClosureSpec, e, ilField: ILFieldSpec, e2, _m) =

0 commit comments

Comments
 (0)