Skip to content

Commit 049389b

Browse files
dsymedsyme
committed
Merge pull request #483 from dsyme/fix-opt-bug
Apply dotnet/fsharp#756
2 parents 23c2084 + fa91ca2 commit 049389b

File tree

2 files changed

+107
-73
lines changed

2 files changed

+107
-73
lines changed

‎src/fsharp/TastOps.fs‎

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

77507750
| _ -> None
77517751

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

77547792
type OptimizeForExpressionOptions = OptimizeIntRangesOnly | OptimizeAllForExpressions
77557793

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

7826-
let expr =
7827-
mkCompGenLet m currentVar enumerableExpr
7828-
(mkCompGenLet m nextVar tailOrNullExpr whileExpr)
7858+
let expr =
7859+
mkCompGenLet m currentVar enumerableExpr
7860+
(mkCompGenLet m nextVar tailOrNullExpr whileExpr)
78297861

7830-
expr
7831-
| _ -> expr
7862+
expr
7863+
7864+
else
7865+
expr
78327866
| _ -> expr
78337867

78347868
// 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
@@ -6550,7 +6550,7 @@ and TcForEachExpr cenv overallTy env tpenv (pat,enumSynExpr,body,m,spForLoop) =
65506550
// Build iteration as a while loop with a try/finally disposal
65516551
| Choice3Of3(enumerableVar,enumeratorVar, _,getEnumExpr,_,guardExpr,currentExpr) ->
65526552

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

0 commit comments

Comments
 (0)