Skip to content

Apply https://github.com/Microsoft/visualfsharp/pull/756/ #483

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

Merged
dsyme merged 1 commit into from
Dec 3, 2015
Merged

Apply https://github.com/Microsoft/visualfsharp/pull/756/ #483

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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 @@ -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
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 @@ -6550,7 +6550,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