Skip to content

Commit 6fa5004

Browse files
dsymedsyme
committed
Merge pull request #527 from dsyme/apply-opt-fix
fix problem with loop optimization
2 parents 0464532 + 04cd959 commit 6fa5004

File tree

3 files changed

+132
-73
lines changed

3 files changed

+132
-73
lines changed

‎src/fsharp/TastOps.fs‎

Lines changed: 106 additions & 72 deletions
Original file line numberDiff line numberDiff line change
@@ -7748,86 +7748,120 @@ let (|RangeInt32Step|_|) g expr =
77487748

77497749
| _ -> None
77507750

7751-
let (|ExtractTypeOfExpr|_|) g expr = Some (tyOfExpr g expr)
7751+
let (|GetEnumeratorCall|_|) expr =
7752+
match expr with
7753+
| Expr.Op (TOp.ILCall( _, _, _, _, _, _, _, iLMethodRef, _, _, _),_,[Expr.Val(vref,_,_) | Expr.Op(_, _, [Expr.Val(vref, ValUseFlag.NormalValUse, _)], _) ],_) ->
7754+
if iLMethodRef.Name = "GetEnumerator" then Some(vref)
7755+
else None
7756+
| _ -> None
7757+
7758+
let (|CompiledForEachExpr|_|) g expr =
7759+
match expr with
7760+
| Let (enumerableVar, enumerableExpr, _,
7761+
Let (enumeratorVar, GetEnumeratorCall enumerableVar2, enumeratorBind,
7762+
TryFinally (WhileLoopForCompiledForEachExpr (_, Let (elemVar,_,_,bodyExpr), _), _)))
7763+
// Apply correctness conditions to ensure this really is a compiled for-each expression.
7764+
when valRefEq g (mkLocalValRef enumerableVar) enumerableVar2 &&
7765+
enumerableVar.IsCompilerGenerated &&
7766+
enumeratorVar.IsCompilerGenerated &&
7767+
let fvs = (freeInExpr CollectLocals bodyExpr)
7768+
not (Zset.contains enumerableVar fvs.FreeLocals) &&
7769+
not (Zset.contains enumeratorVar fvs.FreeLocals) ->
7770+
7771+
// Extract useful ranges
7772+
let m = enumerableExpr.Range
7773+
let mBody = bodyExpr.Range
7774+
7775+
let spForLoop,mForLoop = match enumeratorBind with SequencePointAtBinding(spStart) -> SequencePointAtForLoop(spStart),spStart | _ -> NoSequencePointAtForLoop,m
7776+
let spWhileLoop = match enumeratorBind with SequencePointAtBinding(spStart) -> SequencePointAtWhileLoop(spStart)| _ -> NoSequencePointAtWhileLoop
7777+
let enumerableTy = tyOfExpr g enumerableExpr
7778+
7779+
Some (enumerableTy, enumerableExpr, elemVar, bodyExpr, (m, mBody, spForLoop, mForLoop, spWhileLoop))
7780+
| _ -> None
7781+
7782+
7783+
let (|CompiledInt32RangeForEachExpr|_|) g expr =
7784+
match expr with
7785+
| CompiledForEachExpr g (_, RangeInt32Step g (startExpr, step, finishExpr), elemVar, bodyExpr, ranges) ->
7786+
Some (startExpr, step, finishExpr, elemVar, bodyExpr, ranges)
7787+
| _ -> None
7788+
| _ -> None
7789+
77527790

77537791
type OptimizeForExpressionOptions = OptimizeIntRangesOnly | OptimizeAllForExpressions
77547792

77557793
let DetectAndOptimizeForExpression g option expr =
7756-
match expr with
7757-
| Let (_, enumerableExpr, _,
7758-
Let (_, _, enumeratorBind,
7759-
TryFinally (WhileLoopForCompiledForEachExpr (_, Let (elemVar,_,_,bodyExpr), _), _))) ->
7760-
7761-
let m = enumerableExpr.Range
7762-
let mBody = bodyExpr.Range
7763-
7764-
let spForLoop,mForLoop = match enumeratorBind with SequencePointAtBinding(spStart) -> SequencePointAtForLoop(spStart),spStart | _ -> NoSequencePointAtForLoop,m
7765-
let spWhileLoop = match enumeratorBind with SequencePointAtBinding(spStart) -> SequencePointAtWhileLoop(spStart)| _ -> NoSequencePointAtWhileLoop
7766-
7767-
match option,enumerableExpr with
7768-
| _,RangeInt32Step g (startExpr, step, finishExpr) ->
7769-
match step with
7770-
| -1 | 1 ->
7771-
mkFastForLoop g (spForLoop,m,elemVar,startExpr,(step = 1),finishExpr,bodyExpr)
7772-
| _ -> expr
7773-
| OptimizeAllForExpressions,ExtractTypeOfExpr g ty when isStringTy g ty ->
7774-
// type is string, optimize for expression as:
7775-
// let $str = enumerable
7776-
// for $idx in 0..(str.Length - 1) do
7777-
// let elem = str.[idx]
7778-
// body elem
7779-
7780-
let strVar ,strExpr = mkCompGenLocal m "str" ty
7781-
let idxVar ,idxExpr = mkCompGenLocal m "idx" g.int32_ty
7782-
7783-
let lengthExpr = mkGetStringLength g m strExpr
7784-
let charExpr = mkGetStringChar g m strExpr idxExpr
7785-
7786-
let startExpr = mkZero g m
7787-
let finishExpr = mkDecr g mForLoop lengthExpr
7788-
let loopItemExpr = mkCoerceIfNeeded g elemVar.Type g.char_ty charExpr // for compat reasons, loop item over string is sometimes object, not char
7789-
let bodyExpr = mkCompGenLet mBody elemVar loopItemExpr bodyExpr
7790-
let forExpr = mkFastForLoop g (spForLoop,m,idxVar,startExpr,true,finishExpr,bodyExpr)
7791-
let expr = mkCompGenLet m strVar enumerableExpr forExpr
7792-
7793-
expr
7794-
| OptimizeAllForExpressions,ExtractTypeOfExpr g ty when isListTy g ty ->
7795-
// type is list, optimize for expression as:
7796-
// let mutable $currentVar = listExpr
7797-
// let mutable $nextVar = $tailOrNull
7798-
// while $guardExpr do
7799-
// let i = $headExpr
7800-
// bodyExpr ()
7801-
// $current <- $next
7802-
// $next <- $tailOrNull
7803-
7804-
let IndexHead = 0
7805-
let IndexTail = 1
7806-
7807-
let currentVar ,currentExpr = mkMutableCompGenLocal m "current" ty
7808-
let nextVar ,nextExpr = mkMutableCompGenLocal m "next" ty
7809-
let elemTy = destListTy g ty
7810-
7811-
let guardExpr = mkNonNullTest g m nextExpr
7812-
let headOrDefaultExpr = mkUnionCaseFieldGetUnproven(currentExpr,g.cons_ucref,[elemTy],IndexHead,m)
7813-
let tailOrNullExpr = mkUnionCaseFieldGetUnproven(currentExpr,g.cons_ucref,[elemTy],IndexTail,mBody)
7814-
let bodyExpr =
7815-
mkCompGenLet m elemVar headOrDefaultExpr
7816-
(mkCompGenSequential mBody
7817-
bodyExpr
7794+
match option, expr with
7795+
| _, CompiledInt32RangeForEachExpr g (startExpr, (1 | -1 as step), finishExpr, elemVar, bodyExpr, ranges) ->
7796+
7797+
let (m, _mBody, spForLoop, _mForLoop, _spWhileLoop) = ranges
7798+
mkFastForLoop g (spForLoop,m,elemVar,startExpr,(step = 1),finishExpr,bodyExpr)
7799+
7800+
| OptimizeAllForExpressions,CompiledForEachExpr g (enumerableTy, enumerableExpr, elemVar, bodyExpr, ranges) ->
7801+
7802+
let (m, mBody, spForLoop, mForLoop, spWhileLoop) = ranges
7803+
7804+
if isStringTy g enumerableTy then
7805+
// type is string, optimize for expression as:
7806+
// let $str = enumerable
7807+
// for $idx in 0..(str.Length - 1) do
7808+
// let elem = str.[idx]
7809+
// body elem
7810+
7811+
let strVar ,strExpr = mkCompGenLocal m "str" enumerableTy
7812+
let idxVar ,idxExpr = mkCompGenLocal m "idx" g.int32_ty
7813+
7814+
let lengthExpr = mkGetStringLength g m strExpr
7815+
let charExpr = mkGetStringChar g m strExpr idxExpr
7816+
7817+
let startExpr = mkZero g m
7818+
let finishExpr = mkDecr g mForLoop lengthExpr
7819+
let loopItemExpr = mkCoerceIfNeeded g elemVar.Type g.char_ty charExpr // for compat reasons, loop item over string is sometimes object, not char
7820+
let bodyExpr = mkCompGenLet mBody elemVar loopItemExpr bodyExpr
7821+
let forExpr = mkFastForLoop g (spForLoop,m,idxVar,startExpr,true,finishExpr,bodyExpr)
7822+
let expr = mkCompGenLet m strVar enumerableExpr forExpr
7823+
7824+
expr
7825+
7826+
elif isListTy g enumerableTy then
7827+
// type is list, optimize for expression as:
7828+
// let mutable $currentVar = listExpr
7829+
// let mutable $nextVar = $tailOrNull
7830+
// while $guardExpr do
7831+
// let i = $headExpr
7832+
// bodyExpr ()
7833+
// $current <- $next
7834+
// $next <- $tailOrNull
7835+
7836+
let IndexHead = 0
7837+
let IndexTail = 1
7838+
7839+
let currentVar ,currentExpr = mkMutableCompGenLocal m "current" enumerableTy
7840+
let nextVar ,nextExpr = mkMutableCompGenLocal m "next" enumerableTy
7841+
let elemTy = destListTy g enumerableTy
7842+
7843+
let guardExpr = mkNonNullTest g m nextExpr
7844+
let headOrDefaultExpr = mkUnionCaseFieldGetUnproven(currentExpr,g.cons_ucref,[elemTy],IndexHead,m)
7845+
let tailOrNullExpr = mkUnionCaseFieldGetUnproven(currentExpr,g.cons_ucref,[elemTy],IndexTail,mBody)
7846+
let bodyExpr =
7847+
mkCompGenLet m elemVar headOrDefaultExpr
78187848
(mkCompGenSequential mBody
7819-
(mkValSet mBody (mkLocalValRef currentVar) nextExpr)
7820-
(mkValSet mBody (mkLocalValRef nextVar) tailOrNullExpr)
7849+
bodyExpr
7850+
(mkCompGenSequential mBody
7851+
(mkValSet mBody (mkLocalValRef currentVar) nextExpr)
7852+
(mkValSet mBody (mkLocalValRef nextVar) tailOrNullExpr)
7853+
)
78217854
)
7822-
)
7823-
let whileExpr = mkWhile g (spWhileLoop, WhileLoopForCompiledForEachExprMarker, guardExpr, bodyExpr, m)
7855+
let whileExpr = mkWhile g (spWhileLoop, WhileLoopForCompiledForEachExprMarker, guardExpr, bodyExpr, m)
78247856

7825-
let expr =
7826-
mkCompGenLet m currentVar enumerableExpr
7827-
(mkCompGenLet m nextVar tailOrNullExpr whileExpr)
7857+
let expr =
7858+
mkCompGenLet m currentVar enumerableExpr
7859+
(mkCompGenLet m nextVar tailOrNullExpr whileExpr)
78287860

7829-
expr
7830-
| _ -> expr
7861+
expr
7862+
7863+
else
7864+
expr
78317865
| _ -> expr
78327866

78337867
// Used to remove Expr.Link for inner expressions in pattern matches

‎src/fsharp/TypeChecker.fs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6511,7 +6511,7 @@ and TcForEachExpr cenv overallTy env tpenv (pat,enumSynExpr,body,m,spForLoop) =
65116511
// Build iteration as a while loop with a try/finally disposal
65126512
| Choice3Of3(enumerableVar,enumeratorVar, _,getEnumExpr,_,guardExpr,currentExpr) ->
65136513

6514-
// This compiled for must be matched EXACTLY by DetectFastIntegerForLoops in opt.fs and creflect.fs
6514+
// This compiled for must be matched EXACTLY by CompiledForEachExpr in opt.fs and creflect.fs
65156515
mkCompGenLet enumExpr.Range enumerableVar enumExpr
65166516
(let cleanupE = BuildDisposableCleanup cenv env m enumeratorVar
65176517
let spBind = (match spForLoop with SequencePointAtForLoop(spStart) -> SequencePointAtBinding(spStart) | NoSequencePointAtForLoop -> NoSequencePointAtStickyBinding)

‎tests/fsharp/core/seq/test.fsx‎

Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -491,6 +491,31 @@ check "hfhdfsjkfur34"
491491
Failure "ss!!!" -> results := "caught"::!results
492492
!results)
493493
["caught";"ssDispose";"eDispose"]
494+
495+
// Check https://github.com/Microsoft/visualfsharp/pull/742
496+
497+
module Repro1 =
498+
499+
let configure () =
500+
let aSequence = seq { yield "" }
501+
let aString = new string('a',3)
502+
for _ in aSequence do
503+
System.Console.WriteLine(aString)
504+
505+
do configure ()
506+
/// The check is that the above code compiles OK
507+
508+
module Repro2 =
509+
510+
let configure () =
511+
let aSequence = Microsoft.FSharp.Core.Operators.(..) 3 4
512+
let aString = new string('a',3)
513+
for _ in aSequence do
514+
System.Console.WriteLine(aString)
515+
516+
do configure ()
517+
/// The check is that the above code compiles OK
518+
494519

495520
(*---------------------------------------------------------------------------
496521
!* wrap up

0 commit comments

Comments
 (0)