From a906a2361f309271aacfe77bafb792ece0ef777f Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 3 Dec 2015 15:56:17 +0000 Subject: [PATCH] Apply https://github.com/Microsoft/visualfsharp/pull/756/ --- src/fsharp/TastOps.fs | 178 +++++++++++++++++++++++--------------- src/fsharp/TypeChecker.fs | 2 +- 2 files changed, 107 insertions(+), 73 deletions(-) diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 2816cd7d41..469facae32 100755 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -7749,86 +7749,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 9d6d5bc87e..dd4c84d513 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -6549,7 +6549,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)