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

Optimize integer for loop code gen #13573

Closed
wants to merge 19 commits into from
Closed
Show file tree
Hide file tree
Changes from 15 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
23 changes: 16 additions & 7 deletions src/Compiler/Checking/CheckExpressions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -7559,7 +7559,12 @@ and TcForEachExpr cenv overallTy env tpenv (seqExprOnly, isFromSource, synPat, s
// optimize 'for i in n .. m do'
| Expr.App (Expr.Val (vref, _, _), _, [tyarg], [startExpr;finishExpr], _)
when valRefEq g vref g.range_op_vref && typeEquiv g tyarg g.int_ty ->
(g.int32_ty, (fun _ x -> x), id, Choice1Of3 (startExpr, finishExpr))
(g.int32_ty, (fun _ x -> x), id, Choice1Of4 (startExpr, finishExpr))

// optimize 'for i in n .. step .. m do'
| Expr.App(Expr.Val(vref, _, _), _, [ tyarg; stepTyarg ], [ startExpr; stepExpr; finishExpr ], _)
when valRefEq g vref g.range_step_op_vref && typeEquiv g tyarg g.int_ty && typeEquiv g stepTyarg g.int_ty ->
Copy link
Contributor

Choose a reason for hiding this comment

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

I think we may need to guard this via a language version switch or move this to an optimization phase (though that is painful). It changes the form of quotations for these constructs which is a breaking change.

Quoting these loops is rare but it's also more philosophical: we shouldn't be adding any optimizations which change the quoted form or require new additions to the quotations API. So optimziations should be in later phases.

(g.int32_ty, (fun _ x -> x), id, Choice2Of4(startExpr, stepExpr, finishExpr))

// optimize 'for i in arr do'
| _ when isArray1DTy g enumExprTy ->
Expand All @@ -7574,7 +7579,7 @@ and TcForEachExpr cenv overallTy env tpenv (seqExprOnly, isFromSource, synPat, s
let overallExprFixup overallExpr = mkLet spForBind mFor arrVar enumExpr overallExpr

// Ask for a loop over integers for the given range
(elemTy, bodyExprFixup, overallExprFixup, Choice2Of3 (idxVar, mkZero g mFor, mkDecr g mFor (mkLdlen g mFor arrExpr)))
(elemTy, bodyExprFixup, overallExprFixup, Choice3Of4 (idxVar, mkZero g mFor, mkDecr g mFor (mkLdlen g mFor arrExpr)))

| _ ->
// try optimize 'for i in span do' for span or readonlyspan
Expand All @@ -7599,13 +7604,13 @@ and TcForEachExpr cenv overallTy env tpenv (seqExprOnly, isFromSource, synPat, s
let getLengthCallExpr, _ = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr true getLengthMethInfo ValUseFlag.NormalValUse [] [ spanExpr ] [] None

// Ask for a loop over integers for the given range
(elemTy, bodyExprFixup, overallExprFixup, Choice2Of3 (idxVar, mkZero g mFor, mkDecr g mFor getLengthCallExpr))
(elemTy, bodyExprFixup, overallExprFixup, Choice3Of4 (idxVar, mkZero g mFor, mkDecr g mFor getLengthCallExpr))

| _ ->
let enumerableVar, enumerableExprInVar = mkCompGenLocal mEnumExpr "inputSequence" enumExprTy
let enumeratorVar, enumeratorExpr, _, enumElemTy, getEnumExpr, getEnumTy, guardExpr, _, currentExpr =
AnalyzeArbitraryExprAsEnumerable cenv env true mEnumExpr enumExprTy enumerableExprInVar
(enumElemTy, (fun _ x -> x), id, Choice3Of3(enumerableVar, enumeratorVar, enumeratorExpr, getEnumExpr, getEnumTy, guardExpr, currentExpr))
(enumElemTy, (fun _ x -> x), id, Choice4Of4(enumerableVar, enumeratorVar, enumeratorExpr, getEnumExpr, getEnumTy, guardExpr, currentExpr))

let pat, _, vspecs, envinner, tpenv =
let env = { env with eIsControlFlow = false }
Expand Down Expand Up @@ -7643,15 +7648,19 @@ and TcForEachExpr cenv overallTy env tpenv (seqExprOnly, isFromSource, synPat, s
match iterationTechnique with

// Build iteration as a for loop
| Choice1Of3(startExpr, finishExpr) ->
| Choice1Of4(startExpr, finishExpr) ->
mkFastForLoop g (spFor, spIn, mWholeExpr, elemVar, startExpr, true, finishExpr, bodyExpr)

// Build iteration as a for loop with step value
| Choice2Of4(startExpr, stepExpr, finishExpr) ->
mkIntegerForLoopWithStep g (spFor, spIn, elemVar, startExpr, stepExpr, finishExpr, bodyExpr, mWholeExpr)

// Build iteration as a for loop with a specific index variable that is not the same as the elemVar
| Choice2Of3(idxVar, startExpr, finishExpr) ->
| Choice3Of4(idxVar, startExpr, finishExpr) ->
mkFastForLoop g (DebugPointAtFor.No, spIn, mWholeExpr, idxVar, startExpr, true, finishExpr, bodyExpr)

// Build iteration as a while loop with a try/finally disposal
| Choice3Of3(enumerableVar, enumeratorVar, _, getEnumExpr, _, guardExpr, currentExpr) ->
| Choice4Of4(enumerableVar, enumeratorVar, _, getEnumExpr, _, guardExpr, currentExpr) ->

// This compiled for must be matched EXACTLY by CompiledForEachExpr
mkLet spForBind mFor enumerableVar enumExpr
Expand Down
7 changes: 6 additions & 1 deletion src/Compiler/Checking/PostInferenceChecks.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1060,9 +1060,10 @@ and TryCheckResumableCodeConstructs cenv env expr : bool =
true

// Integer for-loops are allowed but their bodies are not currently resumable
| IntegerForLoopExpr (_sp1, _sp2, _style, e1, e2, v, e3, _m) ->
| IntegerForLoopExpr (_sp1, _sp2, _style, e1, e2, v, e3, e4, _m) ->
CheckExprNoByrefs cenv { env with resumableCode = Resumable.None } e1
CheckExprNoByrefs cenv { env with resumableCode = Resumable.None } e2
Option.iter (CheckExprNoByrefs cenv { env with resumableCode = Resumable.None }) e4
BindVal cenv env v
CheckExprNoByrefs cenv { env with resumableCode = Resumable.None } e3
true
Expand Down Expand Up @@ -1453,6 +1454,10 @@ and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr =
CheckTypeInstNoByrefs cenv env m tyargs
CheckExprsNoByRefLike cenv env [e1;e2;e3]

| TOp.IntegerForLoop _, _, [Expr.Lambda (_, _, _, [_], e1, _, _);Expr.Lambda (_, _, _, [_], e2, _, _);Expr.Lambda (_, _, _, [_], e3, _, _);Expr.Lambda (_, _, _, [_], e4, _, _)] ->
CheckTypeInstNoByrefs cenv env m tyargs
CheckExprsNoByRefLike cenv env [e1;e2;e3;e4]

| TOp.TryWith _, [_], [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [_], _e2, _, _); Expr.Lambda (_, _, _, [_], e3, _, _)] ->
CheckTypeInstNoInnerByrefs cenv env m tyargs // result of a try/catch can be a byref
ctorLimitedZoneCheck()
Expand Down
3 changes: 3 additions & 0 deletions src/Compiler/Checking/QuotationTranslator.fs
Original file line number Diff line number Diff line change
Expand Up @@ -665,6 +665,9 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.
| FSharpForLoopUp -> QP.mkIntegerForLoop(ConvExpr cenv env lim0, ConvExpr cenv env lim1, ConvExpr cenv env body)
| _ -> wfail(Error(FSComp.SR.crefQuotationsCantContainDescendingForLoops(), m))

| TOp.IntegerForLoop (_, _, _), [], [Expr.Lambda (_, _, _, [_], lim0, _, _);Expr.Lambda (_, _, _, [_], lim1, _, _);body; Expr.Lambda (_, _, _, [_], step, _, _)] ->
Copy link
Contributor

Choose a reason for hiding this comment

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

I'm concerned by the addition of these new quotation constructs, see above

QP.mkIntegerForLoopWithStep(ConvExpr cenv env lim0, ConvExpr cenv env lim1, ConvExpr cenv env body, ConvExpr cenv env step)

| TOp.ILCall (_, _, _, isCtor, valUseFlag, isProperty, _, ilMethRef, enclTypeInst, methInst, _), [], callArgs ->
let parentTyconR = ConvILTypeRefUnadjusted cenv m ilMethRef.DeclaringTypeRef
let isNewObj = isCtor || (match valUseFlag with CtorValUsedAsSuperInit | CtorValUsedAsSelfInit -> true | _ -> false)
Expand Down
164 changes: 128 additions & 36 deletions src/Compiler/CodeGen/IlxGen.fs
Original file line number Diff line number Diff line change
Expand Up @@ -3014,7 +3014,13 @@ and GenExprAux (cenv: cenv) (cgbuf: CodeGenBuffer) eenv expr (sequel: sequel) =
GenWhileLoop cenv cgbuf eenv (sp, e1, e2, m) sequel
| TOp.IntegerForLoop (spFor, spTo, dir),
[ Expr.Lambda (_, _, _, [ _ ], e1, _, _); Expr.Lambda (_, _, _, [ _ ], e2, _, _); Expr.Lambda (_, _, _, [ v ], e3, _, _) ],
[] -> GenIntegerForLoop cenv cgbuf eenv (spFor, spTo, v, e1, dir, e2, e3, m) sequel
[] -> GenIntegerForLoop cenv cgbuf eenv (spFor, spTo, v, e1, dir, e2, e3, mkZero g (range ()), m) sequel
| TOp.IntegerForLoop (spFor, spTo, dir),
[ Expr.Lambda (_, _, _, [ _ ], e1, _, _)
Expr.Lambda (_, _, _, [ _ ], e2, _, _)
Expr.Lambda (_, _, _, [ v ], e3, _, _)
Expr.Lambda (_, _, _, [ _ ], e4, _, _) ],
[] -> GenIntegerForLoop cenv cgbuf eenv (spFor, spTo, v, e1, dir, e2, e3, e4, m) sequel
| TOp.TryFinally (spTry, spFinally),
[ Expr.Lambda (_, _, _, [ _ ], e1, _, _); Expr.Lambda (_, _, _, [ _ ], e2, _, _) ],
[ resTy ] -> GenTryFinally cenv cgbuf eenv (e1, e2, m, resTy, spTry, spFinally) sequel
Expand Down Expand Up @@ -4889,7 +4895,7 @@ and GenTryFinally cenv cgbuf eenv (bodyExpr, handlerExpr, m, resTy, spTry, spFin
// Generate for-loop
//--------------------------------------------------------------------------

and GenIntegerForLoop cenv cgbuf eenv (spFor, spTo, v, e1, dir, e2, loopBody, m) sequel =
and GenIntegerForLoop cenv cgbuf eenv (spFor, spTo, v, e1, dir, e2, loopBody, stepExpr, m) sequel =
let eenv = SetIsInLoop true eenv
let g = cenv.g

Expand All @@ -4906,19 +4912,19 @@ and GenIntegerForLoop cenv cgbuf eenv (spFor, spTo, v, e1, dir, e2, loopBody, m)
let test = CG.GenerateDelayMark cgbuf "for_test"
let stack, eenvinner = EmitSaveStack cenv cgbuf eenv m (start, finish)

let isUp =
(match dir with
| FSharpForLoopUp
| CSharpForLoopUp -> true
| FSharpForLoopDown -> false)

let isFSharpStyle =
(match dir with
| FSharpForLoopUp
| FSharpForLoopDown -> true
| CSharpForLoopUp -> false)
let stepByOne, isFSharpStyle, isUp =
match dir with
| FSharpForLoopUp -> true, true, true
| FSharpForLoopDown -> true, true, false
| FSharpForLoopWithStep _ -> false, true, true
| CSharpForLoopUp -> true, false, true

let stepConst =
match stepExpr with
| Expr.Const (Const.Int32 i, _, _) when i <> 0 -> Some i
| _ -> None

let finishIdx, eenvinner =
let finishIdx, stepIdx, eenvinner =
if isFSharpStyle then
// Ensure that we have an g.CompilerGlobalState
assert (g.CompilerGlobalState |> Option.isSome)
Expand All @@ -4929,9 +4935,15 @@ and GenIntegerForLoop cenv cgbuf eenv (spFor, spTo, v, e1, dir, e2, loopBody, m)
let v, _realloc, eenvinner =
AllocLocal cenv cgbuf eenvinner true (vName, g.ilg.typ_Int32, false) (start, finish)

v, eenvinner
if not stepByOne && Option.isNone stepConst then
let v2, _realloc, eenvinner =
AllocLocal cenv cgbuf eenvinner true (vName, g.ilg.typ_Int32, false) (start, finish)

v, v2, eenvinner
else
v, -1, eenvinner
else
-1, eenvinner
-1, -1, eenvinner

let _, eenvinner = AllocLocalVal cenv cgbuf v eenvinner None (start, finish)

Expand All @@ -4942,15 +4954,39 @@ and GenIntegerForLoop cenv cgbuf eenv (spFor, spTo, v, e1, dir, e2, loopBody, m)
GenExpr cenv cgbuf eenv e1 Continue
GenStoreVal cgbuf eenvinner m v

match dir, stepConst with
| FSharpForLoopWithStep, None ->
// Throw invalidarg at runtime if step is 0.
// Emulates behavior of the RangeInt32 enumerator that this replaces.
GenExpr cenv cgbuf eenvinner stepExpr Continue
EmitSetLocal cgbuf stepIdx
EmitGetLocal cgbuf g.ilg.typ_Int32 stepIdx

let notZero = CG.GenerateDelayMark cgbuf "notZero"
CG.EmitInstr cgbuf (pop 1) Push0 (I_brcmp(BI_brtrue, notZero.CodeLabel))

let arg1 = mkString g stepExpr.Range (SR.GetString "StepCannotBeZero")
let arg2 = mkString g stepExpr.Range "step"
let invalidArgExpr = MakeArgumentExnExpr cenv eenv (arg1, arg2, stepExpr.Range)
GenExpr cenv cgbuf eenvinner invalidArgExpr Continue
CG.EmitInstr cgbuf (pop 1) Push0 I_throw

CG.SetMarkToHere cgbuf notZero
| _ -> ()

if isFSharpStyle then
GenExpr cenv cgbuf eenvinner e2 Continue
EmitSetLocal cgbuf finishIdx
EmitGetLocal cgbuf g.ilg.typ_Int32 finishIdx
GenGetLocalVal cenv cgbuf eenvinner e2.Range v None
CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp((if isUp then BI_blt else BI_bgt), finish.CodeLabel))

else
CG.EmitInstr cgbuf (pop 0) Push0 (I_br test.CodeLabel)
if stepByOne then
EmitGetLocal cgbuf g.ilg.typ_Int32 finishIdx
GenGetLocalVal cenv cgbuf eenvinner e2.Range v None

match dir with
| FSharpForLoopUp -> CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_blt, finish.CodeLabel))
| FSharpForLoopDown -> CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bgt, finish.CodeLabel))
| FSharpForLoopWithStep
| CSharpForLoopUp -> CG.EmitInstr cgbuf (pop 0) Push0 (I_br test.CodeLabel)

cgbuf.EmitStartOfHiddenCode()

Expand All @@ -4963,37 +4999,83 @@ and GenIntegerForLoop cenv cgbuf eenv (spFor, spTo, v, e1, dir, e2, loopBody, m)
// v++ or v--
GenGetLocalVal cenv cgbuf eenvinner e2.Range v None

CG.EmitInstr cgbuf (pop 0) (Push [ g.ilg.typ_Int32 ]) (mkLdcInt32 1)
CG.EmitInstr cgbuf (pop 1) Push0 (if isUp then AI_add else AI_sub)
match dir with
| FSharpForLoopUp
| FSharpForLoopDown
| CSharpForLoopUp ->
CG.EmitInstr cgbuf (pop 0) (Push [ g.ilg.typ_Int32 ]) (mkLdcInt32 1)
CG.EmitInstr cgbuf (pop 1) Push0 (if isUp then AI_add else AI_sub)
| FSharpForLoopWithStep _ ->
match stepConst with
| Some sc ->
let pos = sc > 0
CG.EmitInstr cgbuf (pop 0) (Push [ g.ilg.typ_Int32 ]) (mkLdcInt32 (if pos then sc else -sc))
CG.EmitInstr cgbuf (pop 1) Push0 (if pos then AI_add else AI_sub)
| None ->
EmitGetLocal cgbuf g.ilg.typ_Int32 stepIdx
CG.EmitInstr cgbuf (pop 1) Push0 AI_add

GenStoreVal cgbuf eenvinner m v

// .text
// .test
CG.SetMarkToHere cgbuf test

// FSharpForLoopUp: if v <> e2 + 1 then goto .inner
// FSharpForLoopDown: if v <> e2 - 1 then goto .inner
// FSharpForLoopWithStep: if (step > 0 && v <= e2) || (step < 0 && v >= e2) then goto .inner (variable step)
// FSharpForLoopWithStep: if v <= e2 && v >= e1 then goto .inner (constant step > 0)
// FSharpForLoopWithStep: if v >= e2 && v <= e1 then goto .inner (constant step < 0)
// CSharpStyle: if v < e2 then goto .inner
match spTo with
| DebugPointAtInOrTo.Yes spStart -> CG.EmitDebugPoint cgbuf spStart
| DebugPointAtInOrTo.No -> ()

GenGetLocalVal cenv cgbuf eenvinner e2.Range v None

let cmp =
match dir with
| FSharpForLoopUp
| FSharpForLoopDown -> BI_bne_un
| CSharpForLoopUp -> BI_blt

let e2Sequel = (CmpThenBrOrContinue(pop 2, [ I_brcmp(cmp, inner.CodeLabel) ]))

if isFSharpStyle then
match dir with
| FSharpForLoopUp
| FSharpForLoopDown ->
EmitGetLocal cgbuf g.ilg.typ_Int32 finishIdx
CG.EmitInstr cgbuf (pop 0) (Push [ g.ilg.typ_Int32 ]) (mkLdcInt32 1)
CG.EmitInstr cgbuf (pop 1) Push0 (if isUp then AI_add else AI_sub)
GenSequel cenv eenv.cloc cgbuf e2Sequel
else
GenExpr cenv cgbuf eenv e2 e2Sequel

CmpThenBrOrContinue(pop 2, [ I_brcmp(BI_bne_un, inner.CodeLabel) ])
|> GenSequel cenv eenv.cloc cgbuf

| FSharpForLoopWithStep _ ->

match stepConst with
| Some sc ->
let pos = sc > 0

GenExpr cenv cgbuf eenv e1 Continue
CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp((if pos then BI_blt else BI_bgt), finish.CodeLabel))

GenGetLocalVal cenv cgbuf eenvinner e2.Range v None
EmitGetLocal cgbuf g.ilg.typ_Int32 finishIdx
CmpThenBrOrContinue(pop 2, [ I_brcmp((if pos then BI_ble else BI_bge), inner.CodeLabel) ])
| None ->
EmitGetLocal cgbuf g.ilg.typ_Int32 finishIdx
let testPassed = CG.GenerateDelayMark cgbuf "testPassed"
CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_ble, testPassed.CodeLabel))

EmitGetLocal cgbuf g.ilg.typ_Int32 stepIdx
CG.EmitInstr cgbuf (pop 0) (Push [ g.ilg.typ_Int32 ]) (mkLdcInt32 0)
CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bgt, finish.CodeLabel))

CG.SetMarkToHere cgbuf testPassed
GenGetLocalVal cenv cgbuf eenvinner e2.Range v None
EmitGetLocal cgbuf g.ilg.typ_Int32 finishIdx
CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bge, inner.CodeLabel))

EmitGetLocal cgbuf g.ilg.typ_Int32 stepIdx
CG.EmitInstr cgbuf (pop 0) (Push [ g.ilg.typ_Int32 ]) (mkLdcInt32 0)
CmpThenBrOrContinue(pop 2, [ I_brcmp(BI_bge, inner.CodeLabel) ])
|> GenSequel cenv eenv.cloc cgbuf

| CSharpForLoopUp ->
CmpThenBrOrContinue(pop 2, [ I_brcmp(BI_blt, inner.CodeLabel) ])
|> GenExpr cenv cgbuf eenv e2

// .finish - loop-exit here
CG.SetMarkToHere cgbuf finish
Expand Down Expand Up @@ -5407,6 +5489,16 @@ and MakeNotSupportedExnExpr cenv eenv (argExpr, m) =
let mref = mkILCtorMethSpecForTy(ilTy, [ g.ilg.typ_String ]).MethodRef
Expr.Op(TOp.ILCall(false, false, false, true, NormalValUse, false, false, mref, [], [], [ ety ]), [], [ argExpr ], m)

and MakeArgumentExnExpr cenv eenv (messageExpr, argNameExpr, m) =
let g = cenv.g
let ety = mkAppTy (g.FindSysTyconRef [ "System" ] "ArgumentException") []
let ilTy = GenType cenv m eenv.tyenv ety

let mref =
mkILCtorMethSpecForTy(ilTy, [ g.ilg.typ_String; g.ilg.typ_String ]).MethodRef

Expr.Op(TOp.ILCall(false, false, false, true, NormalValUse, false, false, mref, [], [], [ ety ]), [], [ messageExpr; argNameExpr ], m)

and GenTraitCall (cenv: cenv) cgbuf eenv (traitInfo: TraitConstraintInfo, argExprs, m) expr sequel =
let g = cenv.g
let generateWitnesses = ComputeGenerateWitnesses g eenv
Expand Down
3 changes: 3 additions & 0 deletions src/Compiler/FSStrings.resx
Original file line number Diff line number Diff line change
Expand Up @@ -1110,4 +1110,7 @@
<data name="NotUpperCaseConstructorWithoutRQA" xml:space="preserve">
<value>Lowercase discriminated union cases are only allowed when using RequireQualifiedAccess attribute</value>
</data>
<data name="StepCannotBeZero" xml:space="preserve">
<value>The step of a range cannot be zero.</value>
</data>
</root>
Loading