Skip to content

Commit

Permalink
Apply dotnet/fsharp#756
Browse files Browse the repository at this point in the history
  • Loading branch information
@dsyme
dsyme committed Dec 14, 2015
1 parent b732ae0 commit a906a23
Show file tree
Hide file tree
Showing 2 changed files with 107 additions and 73 deletions.
178 changes: 106 additions & 72 deletions src/fsharp/TastOps.fs
View file
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
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down

0 comments on commit a906a23

Please sign in to comment.