Skip to content

Fix 996 - resource usage of infinite sequence expression containing "let rec" #3536

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
KevinRansom merged 1 commit into from
Sep 1, 2017
Merged

Fix 996 - resource usage of infinite sequence expression containing "let rec" #3536

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
6 changes: 3 additions & 3 deletions src/fsharp/FSharp.Core/prim-types.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3001,7 +3001,7 @@ namespace Microsoft.FSharp.Collections
open Microsoft.FSharp.Core.BasicInlinedOperations

[<DefaultAugmentation(false)>]
[<System.Diagnostics.DebuggerTypeProxyAttribute(typedefof<ListDebugView<_>>)>]
[<DebuggerTypeProxyAttribute(typedefof<ListDebugView<_>>)>]
[<DebuggerDisplay("{DebugDisplay,nq}")>]
[<CodeAnalysis.SuppressMessage("Microsoft.Naming", "CA1710:IdentifiersShouldHaveCorrectSuffix")>]
[<StructuralEquality; StructuralComparison>]
Expand Down Expand Up @@ -3040,10 +3040,10 @@ namespace Microsoft.FSharp.Collections
| [] -> ()
| h::t ->
if i < n then
SetArray items i h;
SetArray items i h
copy items t (i+1)

copy items l 0;
copy items l 0
items

type ResizeArray<'T> = System.Collections.Generic.List<'T>
Expand Down
25 changes: 12 additions & 13 deletions src/fsharp/InnerLambdasToTopLevelFuncs.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -958,12 +958,16 @@ module Pass4_RewriteAssembly =
#endif

/// Wrap preDecs (in order) over an expr - use letrec/let as approp
let MakePreDec m (isRec,binds) expr =
let MakePreDec m (isRec,binds: Bindings) expr =
if isRec=IsRec then
mkLetRecBinds m binds expr
// By definition top level bindings don't refer to non-top level bindings, so we can build them in two parts
let topLevelBinds, nonTopLevelBinds = binds |> List.partition (fun bind -> bind.Var.IsCompiledAsTopLevel)
mkLetRecBinds m topLevelBinds (mkLetRecBinds m nonTopLevelBinds expr)
else
mkLetsFromBindings m binds expr

/// Must MakePreDecs around every construct that could do EnterInner (which filters TLR decs).
/// i.e. let,letrec (bind may...), ilobj, lambda, tlambda.
let MakePreDecs m preDecs expr = List.foldBack (MakePreDec m) preDecs expr

let RecursivePreDecs pdsA pdsB =
Expand Down Expand Up @@ -1099,11 +1103,6 @@ module Pass4_RewriteAssembly =
// pass4: pass (over expr)
//-------------------------------------------------------------------------

/// Must WrapPreDecs around every construct that could do EnterInner (which filters TLR decs).
/// i.e. let,letrec (bind may...), ilobj, lambda, tlambda.
let WrapPreDecs m pds x =
MakePreDecs m pds x

/// At bindings, fixup any TLR bindings.
/// At applications, fixup calls if they are arity-met instances of TLR.
/// At free vals, fixup 0-call if it is an arity-met constant.
Expand Down Expand Up @@ -1146,22 +1145,22 @@ module Pass4_RewriteAssembly =
(tType,objExprs'),z') z iimpls
let expr = Expr.Obj(newUnique(),ty,basev,basecall,overrides,iimpls,m)
let pds,z = ExtractPreDecs z
WrapPreDecs m pds expr,z (* if TopLevel, lift preDecs over the ilobj expr *)
MakePreDecs m pds expr,z (* if TopLevel, lift preDecs over the ilobj expr *)

// lambda, tlambda - explicit lambda terms
| Expr.Lambda(_,ctorThisValOpt,baseValOpt,argvs,body,m,rty) ->
let z = EnterInner z
let body,z = TransExpr penv z body
let z = ExitInner z
let pds,z = ExtractPreDecs z
WrapPreDecs m pds (rebuildLambda m ctorThisValOpt baseValOpt argvs (body,rty)),z
MakePreDecs m pds (rebuildLambda m ctorThisValOpt baseValOpt argvs (body,rty)),z

| Expr.TyLambda(_,argtyvs,body,m,rty) ->
let z = EnterInner z
let body,z = TransExpr penv z body
let z = ExitInner z
let pds,z = ExtractPreDecs z
WrapPreDecs m pds (mkTypeLambda m argtyvs (body,rty)),z
MakePreDecs m pds (mkTypeLambda m argtyvs (body,rty)),z

/// Lifting TLR out over constructs (disabled)
/// Lift minimally to ensure the defn is not lifted up and over defns on which it depends (disabled)
Expand All @@ -1171,7 +1170,7 @@ module Pass4_RewriteAssembly =
let targets,z = List.mapFold (TransDecisionTreeTarget penv) z targets
// TransDecisionTreeTarget wraps EnterInner/exitInnter, so need to collect any top decs
let pds,z = ExtractPreDecs z
WrapPreDecs m pds (mkAndSimplifyMatch spBind exprm m ty dtree targets),z
MakePreDecs m pds (mkAndSimplifyMatch spBind exprm m ty dtree targets),z

// all others - below - rewrite structurally - so boiler plate code after this point...
| Expr.Const _ -> expr,z (* constant wrt Val *)
Expand Down Expand Up @@ -1216,7 +1215,7 @@ module Pass4_RewriteAssembly =
// tailcall
TransLinearExpr penv z e (contf << (fun (e,z) ->
let e = mkLetsFromBindings m rebinds e
WrapPreDecs m pds (Expr.LetRec (binds,e,m,NewFreeVarsCache())),z))
MakePreDecs m pds (Expr.LetRec (binds,e,m,NewFreeVarsCache())),z))

// let - can consider the mu-let bindings as mu-letrec bindings - so like as above
| Expr.Let (bind,e,m,_) ->
Expand All @@ -1232,7 +1231,7 @@ module Pass4_RewriteAssembly =
// tailcall
TransLinearExpr penv z e (contf << (fun (e,z) ->
let e = mkLetsFromBindings m rebinds e
WrapPreDecs m pds (mkLetsFromBindings m binds e),z))
MakePreDecs m pds (mkLetsFromBindings m binds e),z))

| LinearMatchExpr (spBind,exprm,dtree,tg1,e2,sp2,m2,ty) ->
let dtree,z = TransDecisionTree penv z dtree
Expand Down
102 changes: 72 additions & 30 deletions src/fsharp/LowerCallsAndSeqs.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -179,6 +179,39 @@ let LowerSeqExpr g amap overallExpr =
| Expr.App(Expr.Val (vref,_,_),_f0ty,[elemTy],[e],_m) when valRefEq g vref g.seq_vref -> Some (e,elemTy)
| _ -> None

let RepresentBindingAsStateMachineLocal (bind: Binding) res2 m =
// printfn "found letrec state variable %s" bind.Var.DisplayName
let (TBind(v,e,sp)) = bind
let sp,spm =
match sp with
| SequencePointAtBinding m -> SequencePointsAtSeq,m
| _ -> SuppressSequencePointOnExprOfSequential,e.Range
let vref = mkLocalValRef v
{ res2 with
phase2 = (fun ctxt ->
let generate2,dispose2,checkDispose2 = res2.phase2 ctxt
let generate =
mkCompGenSequential m
(mkSequential sp m
(mkValSet spm vref e)
generate2)
// zero out the current value to free up its memory
(mkValSet m vref (mkDefault (m,vref.Type)))
let dispose = dispose2
let checkDispose = checkDispose2
generate,dispose,checkDispose)
stateVars = vref::res2.stateVars }

let RepresentBindingsAsLifted mkBinds res2 =
// printfn "found top level let "
{ res2 with
phase2 = (fun ctxt ->
let generate2,dispose2,checkDispose2 = res2.phase2 ctxt
let generate = mkBinds generate2
let dispose = dispose2
let checkDispose = checkDispose2
generate,dispose, checkDispose) }

let rec Lower
isWholeExpr
isTailCall // is this sequence in tailcall position?
Expand Down Expand Up @@ -220,6 +253,7 @@ let LowerSeqExpr g amap overallExpr =
| SeqDelay(e,_elemTy) ->
// printfn "found Seq.delay"
Lower isWholeExpr isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel e // note, using 'isWholeExpr' here prevents 'seq { yield! e }' and 'seq { 0 .. 1000 }' from being compiled

| SeqAppend(e1,e2,m) ->
// printfn "found Seq.append"
match Lower false false noDisposeContinuationLabel currentDisposeContinuationLabel e1,
Expand All @@ -239,6 +273,7 @@ let LowerSeqExpr g amap overallExpr =
significantClose = res1.significantClose || res2.significantClose }
| _ ->
None

| SeqWhile(e1,e2,m) ->
// printfn "found Seq.while"
match Lower false false noDisposeContinuationLabel currentDisposeContinuationLabel e2 with
Expand All @@ -254,9 +289,11 @@ let LowerSeqExpr g amap overallExpr =
significantClose = res2.significantClose }
| _ ->
None

| SeqUsing(resource,v,body,elemTy,m) ->
// printfn "found Seq.using"
Lower false isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel (mkLet (SequencePointAtBinding body.Range) m v resource (mkCallSeqFinally g m elemTy body (mkUnitDelayLambda g m (mkCallDispose g m v.Type (exprForVal m v)))))

| SeqFor(inp,v,body,genElemTy,m) ->
// printfn "found Seq.for"
let inpElemTy = v.Type
Expand All @@ -272,6 +309,7 @@ let LowerSeqExpr g amap overallExpr =
(mkCallSeqGenerated g m genElemTy (mkUnitDelayLambda g m (callNonOverloadedMethod g amap m "MoveNext" inpEnumTy [enume]))
(mkInvisibleLet m v (callNonOverloadedMethod g amap m "get_Current" inpEnumTy [enume])
body))))

| SeqTryFinally(e1,compensation,m) ->
// printfn "found Seq.try/finally"
let innerDisposeContinuationLabel = IL.generateCodeLabel()
Expand Down Expand Up @@ -318,6 +356,7 @@ let LowerSeqExpr g amap overallExpr =
significantClose = true }
| _ ->
None

| SeqEmpty m ->
// printfn "found Seq.empty"
Some { phase2 = (fun _ ->
Expand All @@ -328,6 +367,7 @@ let LowerSeqExpr g amap overallExpr =
labels = []
stateVars = []
significantClose = false }

| Expr.Sequential(x1,x2,NormalSeq,ty,m) ->
match Lower false isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel x2 with
| Some res2->
Expand All @@ -343,41 +383,43 @@ let LowerSeqExpr g amap overallExpr =

| Expr.Let(bind,e2,m,_)
// Restriction: compilation of sequence expressions containing non-toplevel constrained generic functions is not supported
when not bind.Var.IsCompiledAsTopLevel &&
not (IsGenericValWithGenericContraints g bind.Var) ->
when bind.Var.IsCompiledAsTopLevel || not (IsGenericValWithGenericContraints g bind.Var) ->
match Lower false isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel e2 with
| Some res2 ->
if bind.Var.IsCompiledAsTopLevel then
// printfn "found top level let "
Some { res2 with
phase2 = (fun ctxt ->
let generate2,dispose2,checkDispose2 = res2.phase2 ctxt
let generate = mkLetBind m bind generate2
let dispose = dispose2
let checkDispose = checkDispose2
generate,dispose, checkDispose) }
Some (RepresentBindingsAsLifted (mkLetBind m bind) res2)
else
// printfn "found state variable %s" bind.Var.DisplayName
let (TBind(v,e,sp)) = bind
let sp,spm =
match sp with
| SequencePointAtBinding m -> SequencePointsAtSeq,m
| _ -> SuppressSequencePointOnExprOfSequential,e.Range
let vref = mkLocalValRef v
Some { res2 with
phase2 = (fun ctxt ->
let generate2,dispose2,checkDispose2 = res2.phase2 ctxt
let generate =
mkCompGenSequential m
(mkSequential sp m
(mkValSet spm vref e)
generate2)
// zero out the current value to free up its memory
(mkValSet m vref (mkDefault (m,vref.Type)))
let dispose = dispose2
let checkDispose = checkDispose2
generate,dispose,checkDispose)
stateVars = vref::res2.stateVars }
Some (RepresentBindingAsStateMachineLocal bind res2 m)
| None ->
None

| Expr.LetRec(binds,e2,m,_)
when // Restriction: only limited forms of "let rec" in sequence expressions can be handled by assignment to state local values

(let recvars = valsOfBinds binds |> List.map (fun v -> (v,0)) |> ValMap.OfList
binds |> List.forall (fun bind ->
// Rule 1 - IsCompiledAsTopLevel require no state local value
bind.Var.IsCompiledAsTopLevel ||
// Rule 2 - funky constrained local funcs not allowed
not (IsGenericValWithGenericContraints g bind.Var)) &&
binds |> List.count (fun bind ->
// Rule 3 - Recursive non-lambda and repack values are allowed
match stripExpr bind.Expr with
| Expr.Lambda _
| Expr.TyLambda _ -> false
// "let v = otherv" bindings get produced for environment packing by InnerLambdasToTopLevelFuncs.fs, we can accept and compiler these ok
| Expr.Val(v,_,_) when not (recvars.ContainsVal v.Deref) -> false
| _ -> true) <= 1) ->

match Lower false isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel e2 with
| Some res2 ->
let topLevelBinds, nonTopLevelBinds = binds |> List.partition (fun bind -> bind.Var.IsCompiledAsTopLevel)
// Represent the closure-capturing values as state machine locals. They may still be recursively-referential
let res3 = (res2,nonTopLevelBinds) ||> List.fold (fun acc bind -> RepresentBindingAsStateMachineLocal bind acc m)
// Represent the non-closure-capturing values as ordinary bindings on the expression.
let res4 = if topLevelBinds.IsEmpty then res3 else RepresentBindingsAsLifted (mkLetRecBinds m topLevelBinds) res3
Some res4
| None ->
None

Expand Down
Loading