diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 96f25afb6c4..b93f7720be9 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -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) -> + + // 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 diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index e3405fad2b2..4b8ad218061 100644 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -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) diff --git a/tests/fsharp/core/seq/test.fsx b/tests/fsharp/core/seq/test.fsx index cec86850d9f..6965d58306c 100644 --- a/tests/fsharp/core/seq/test.fsx +++ b/tests/fsharp/core/seq/test.fsx @@ -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" + +[] +let main argv = + Stuff.f() + Stuff.f2() + 0 // return an integer exit code (*--------------------------------------------------------------------------- !* wrap up @@ -497,4 +545,4 @@ let aa = do (stdout.WriteLine "Test Passed"; System.IO.File.WriteAllText("test.ok","ok"); - exit 0) \ No newline at end of file + exit 0)