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 problem with loop optimization (#742) #756

Closed
wants to merge 2 commits into from
Closed

fix problem with loop optimization (#742) #756

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
261732c
fix problem with loop optimization
dsyme Dec 3, 2015
bb24268
Update test.fsx
dsyme Dec 4, 2015
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
178 changes: 106 additions & 72 deletions src/fsharp/TastOps.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7748,86 +7748,120 @@ let (|RangeInt32Step|_|) g expr =

| _ -> None

let (|ExtractTypeOfExpr|_|) g expr = Some (tyOfExpr g expr)
let (|GetEnumeratorCall|_|) expr =
match expr with
| Expr.Op (TOp.ILCall( _, _, _, _, _, _, _, iLMethodRef, _, _, _),_,[Expr.Val(vref,_,_) | Expr.Op(_, _, [Expr.Val(vref, ValUseFlag.NormalValUse, _)], _) ],_) ->
if iLMethodRef.Name = "GetEnumerator" then Some(vref)
else None
| _ -> None

let (|CompiledForEachExpr|_|) g expr =
match expr with
| Let (enumerableVar, enumerableExpr, _,
Let (enumeratorVar, GetEnumeratorCall enumerableVar2, enumeratorBind,
TryFinally (WhileLoopForCompiledForEachExpr (_, Let (elemVar,_,_,bodyExpr), _), _)))
// Apply correctness conditions to ensure this really is a compiled for-each expression.
when valRefEq g (mkLocalValRef enumerableVar) enumerableVar2 &&
enumerableVar.IsCompilerGenerated &&
enumeratorVar.IsCompilerGenerated &&
let fvs = (freeInExpr CollectLocals bodyExpr)
not (Zset.contains enumerableVar fvs.FreeLocals) &&
not (Zset.contains enumeratorVar fvs.FreeLocals) ->
Copy link
Member

Choose a reason for hiding this comment

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

Don is this right?

Copy link
Contributor Author

Choose a reason for hiding this comment

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

Yes, I think so - is there something I've missed? The "bodyExpr" is the body of the while loop, but it shouldn't directly refer to either enumerableVar (the variable holding the enumerable collection, which is consumed in GetEnumeratorCall) or enumeratorVar (the variable holding the enumerator for the collection, which is consumed in the binding for the elemVar "let").


// Extract useful ranges
let m = enumerableExpr.Range
let mBody = bodyExpr.Range

let spForLoop,mForLoop = match enumeratorBind with SequencePointAtBinding(spStart) -> SequencePointAtForLoop(spStart),spStart | _ -> NoSequencePointAtForLoop,m
let spWhileLoop = match enumeratorBind with SequencePointAtBinding(spStart) -> SequencePointAtWhileLoop(spStart)| _ -> NoSequencePointAtWhileLoop
let enumerableTy = tyOfExpr g enumerableExpr

Some (enumerableTy, enumerableExpr, elemVar, bodyExpr, (m, mBody, spForLoop, mForLoop, spWhileLoop))
| _ -> None


let (|CompiledInt32RangeForEachExpr|_|) g expr =
match expr with
| CompiledForEachExpr g (_, RangeInt32Step g (startExpr, step, finishExpr), elemVar, bodyExpr, ranges) ->
Some (startExpr, step, finishExpr, elemVar, bodyExpr, ranges)
| _ -> None
| _ -> None


type OptimizeForExpressionOptions = OptimizeIntRangesOnly | OptimizeAllForExpressions

let DetectAndOptimizeForExpression g option expr =
match expr with
| Let (_, enumerableExpr, _,
Let (_, _, enumeratorBind,
TryFinally (WhileLoopForCompiledForEachExpr (_, Let (elemVar,_,_,bodyExpr), _), _))) ->

let m = enumerableExpr.Range
let mBody = bodyExpr.Range

let spForLoop,mForLoop = match enumeratorBind with SequencePointAtBinding(spStart) -> SequencePointAtForLoop(spStart),spStart | _ -> NoSequencePointAtForLoop,m
let spWhileLoop = match enumeratorBind with SequencePointAtBinding(spStart) -> SequencePointAtWhileLoop(spStart)| _ -> NoSequencePointAtWhileLoop

match option,enumerableExpr with
| _,RangeInt32Step g (startExpr, step, finishExpr) ->
match step with
| -1 | 1 ->
mkFastForLoop g (spForLoop,m,elemVar,startExpr,(step = 1),finishExpr,bodyExpr)
| _ -> expr
| OptimizeAllForExpressions,ExtractTypeOfExpr g ty when isStringTy g ty ->
// type is string, optimize for expression as:
// let $str = enumerable
// for $idx in 0..(str.Length - 1) do
// let elem = str.[idx]
// body elem

let strVar ,strExpr = mkCompGenLocal m "str" ty
let idxVar ,idxExpr = mkCompGenLocal m "idx" g.int32_ty

let lengthExpr = mkGetStringLength g m strExpr
let charExpr = mkGetStringChar g m strExpr idxExpr

let startExpr = mkZero g m
let finishExpr = mkDecr g mForLoop lengthExpr
let loopItemExpr = mkCoerceIfNeeded g elemVar.Type g.char_ty charExpr // for compat reasons, loop item over string is sometimes object, not char
let bodyExpr = mkCompGenLet mBody elemVar loopItemExpr bodyExpr
let forExpr = mkFastForLoop g (spForLoop,m,idxVar,startExpr,true,finishExpr,bodyExpr)
let expr = mkCompGenLet m strVar enumerableExpr forExpr

expr
| OptimizeAllForExpressions,ExtractTypeOfExpr g ty when isListTy g ty ->
// type is list, optimize for expression as:
// let mutable $currentVar = listExpr
// let mutable $nextVar = $tailOrNull
// while $guardExpr do
// let i = $headExpr
// bodyExpr ()
// $current <- $next
// $next <- $tailOrNull

let IndexHead = 0
let IndexTail = 1

let currentVar ,currentExpr = mkMutableCompGenLocal m "current" ty
let nextVar ,nextExpr = mkMutableCompGenLocal m "next" ty
let elemTy = destListTy g ty

let guardExpr = mkNonNullTest g m nextExpr
let headOrDefaultExpr = mkUnionCaseFieldGetUnproven(currentExpr,g.cons_ucref,[elemTy],IndexHead,m)
let tailOrNullExpr = mkUnionCaseFieldGetUnproven(currentExpr,g.cons_ucref,[elemTy],IndexTail,mBody)
let bodyExpr =
mkCompGenLet m elemVar headOrDefaultExpr
(mkCompGenSequential mBody
bodyExpr
match option, expr with
| _, CompiledInt32RangeForEachExpr g (startExpr, (1 | -1 as step), finishExpr, elemVar, bodyExpr, ranges) ->

let (m, _mBody, spForLoop, _mForLoop, _spWhileLoop) = ranges
mkFastForLoop g (spForLoop,m,elemVar,startExpr,(step = 1),finishExpr,bodyExpr)

| OptimizeAllForExpressions,CompiledForEachExpr g (enumerableTy, enumerableExpr, elemVar, bodyExpr, ranges) ->

let (m, mBody, spForLoop, mForLoop, spWhileLoop) = ranges

if isStringTy g enumerableTy then
// type is string, optimize for expression as:
// let $str = enumerable
// for $idx in 0..(str.Length - 1) do
// let elem = str.[idx]
// body elem

let strVar ,strExpr = mkCompGenLocal m "str" enumerableTy
let idxVar ,idxExpr = mkCompGenLocal m "idx" g.int32_ty

let lengthExpr = mkGetStringLength g m strExpr
let charExpr = mkGetStringChar g m strExpr idxExpr

let startExpr = mkZero g m
let finishExpr = mkDecr g mForLoop lengthExpr
let loopItemExpr = mkCoerceIfNeeded g elemVar.Type g.char_ty charExpr // for compat reasons, loop item over string is sometimes object, not char
let bodyExpr = mkCompGenLet mBody elemVar loopItemExpr bodyExpr
let forExpr = mkFastForLoop g (spForLoop,m,idxVar,startExpr,true,finishExpr,bodyExpr)
let expr = mkCompGenLet m strVar enumerableExpr forExpr

expr

elif isListTy g enumerableTy then
// type is list, optimize for expression as:
// let mutable $currentVar = listExpr
// let mutable $nextVar = $tailOrNull
// while $guardExpr do
// let i = $headExpr
// bodyExpr ()
// $current <- $next
// $next <- $tailOrNull

let IndexHead = 0
let IndexTail = 1

let currentVar ,currentExpr = mkMutableCompGenLocal m "current" enumerableTy
let nextVar ,nextExpr = mkMutableCompGenLocal m "next" enumerableTy
let elemTy = destListTy g enumerableTy

let guardExpr = mkNonNullTest g m nextExpr
let headOrDefaultExpr = mkUnionCaseFieldGetUnproven(currentExpr,g.cons_ucref,[elemTy],IndexHead,m)
let tailOrNullExpr = mkUnionCaseFieldGetUnproven(currentExpr,g.cons_ucref,[elemTy],IndexTail,mBody)
let bodyExpr =
mkCompGenLet m elemVar headOrDefaultExpr
(mkCompGenSequential mBody
(mkValSet mBody (mkLocalValRef currentVar) nextExpr)
(mkValSet mBody (mkLocalValRef nextVar) tailOrNullExpr)
bodyExpr
(mkCompGenSequential mBody
(mkValSet mBody (mkLocalValRef currentVar) nextExpr)
(mkValSet mBody (mkLocalValRef nextVar) tailOrNullExpr)
)
)
)
let whileExpr = mkWhile g (spWhileLoop, WhileLoopForCompiledForEachExprMarker, guardExpr, bodyExpr, m)
let whileExpr = mkWhile g (spWhileLoop, WhileLoopForCompiledForEachExprMarker, guardExpr, bodyExpr, m)

let expr =
mkCompGenLet m currentVar enumerableExpr
(mkCompGenLet m nextVar tailOrNullExpr whileExpr)
let expr =
mkCompGenLet m currentVar enumerableExpr
(mkCompGenLet m nextVar tailOrNullExpr whileExpr)

expr
| _ -> expr
expr

else
expr
| _ -> expr

// Used to remove Expr.Link for inner expressions in pattern matches
Expand Down
2 changes: 1 addition & 1 deletion src/fsharp/TypeChecker.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6511,7 +6511,7 @@ and TcForEachExpr cenv overallTy env tpenv (pat,enumSynExpr,body,m,spForLoop) =
// Build iteration as a while loop with a try/finally disposal
| Choice3Of3(enumerableVar,enumeratorVar, _,getEnumExpr,_,guardExpr,currentExpr) ->

// This compiled for must be matched EXACTLY by DetectFastIntegerForLoops in opt.fs and creflect.fs
// This compiled for must be matched EXACTLY by CompiledForEachExpr in opt.fs and creflect.fs
mkCompGenLet enumExpr.Range enumerableVar enumExpr
(let cleanupE = BuildDisposableCleanup cenv env m enumeratorVar
let spBind = (match spForLoop with SequencePointAtForLoop(spStart) -> SequencePointAtBinding(spStart) | NoSequencePointAtForLoop -> NoSequencePointAtStickyBinding)
Expand Down
50 changes: 49 additions & 1 deletion tests/fsharp/core/seq/test.fsx
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -487,6 +487,54 @@ check "hfhdfsjkfur34"
Failure "ss!!!" -> results := "caught"::!results
!results)
["caught";"ssDispose";"eDispose"]

// repros for https://github.com/Microsoft/visualfsharp/pull/742 - Fix error in optimization of for loops over strings and lists

module Repro1 =

let configure () =
let aSequence = seq { yield "" }
let aString = new string('a',3)
for _ in aSequence do
System.Console.WriteLine(aString)

do configure ()
/// The check is that the above code compiles OK

module Repro2 =

let configure () =
let aSequence = Microsoft.FSharp.Core.Operators.(..) 3 4
let aString = new string('a',3)
for _ in aSequence do
System.Console.WriteLine(aString)

do configure ()
/// The check is that the above code compiles OK

module Repro3 =

/// The check is that the code compiles OK
let f() =
let currencies = set [ 1 ; 2 ; 3 ]
let expiries = [ 3 ; 4 ]
for ccy in currencies do
for expiry in expiries do
printfn "Done"

/// The check is that the code compiles OK
let f2() =
let currencies = [ 1 ; 2 ; 3 ]
let expiries = [ 3 ; 4 ]
for ccy in currencies do
for expiry in expiries do
printfn "Done"

[<EntryPoint>]
let main argv =
Stuff.f()
Stuff.f2()
0 // return an integer exit code

(*---------------------------------------------------------------------------
!* wrap up
Expand All @@ -497,4 +545,4 @@ let aa =

do (stdout.WriteLine "Test Passed";
System.IO.File.WriteAllText("test.ok","ok");
exit 0)
exit 0)