Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commit8917d88

Browse files
dsymeKevinRansom
authored andcommitted
Fix 996 - resource usage of infinite sequence expression containing recursive function definitions (#3536)
1 parent0257ff1 commit8917d88

File tree

4 files changed

+284
-46
lines changed

4 files changed

+284
-46
lines changed

‎src/fsharp/FSharp.Core/prim-types.fs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3001,7 +3001,7 @@ namespace Microsoft.FSharp.Collections
30013001
openMicrosoft.FSharp.Core.BasicInlinedOperations
30023002

30033003
[<DefaultAugmentation(false)>]
3004-
[<System.Diagnostics.DebuggerTypeProxyAttribute(typedefof<ListDebugView<_>>)>]
3004+
[<DebuggerTypeProxyAttribute(typedefof<ListDebugView<_>>)>]
30053005
[<DebuggerDisplay("{DebugDisplay,nq}")>]
30063006
[<CodeAnalysis.SuppressMessage("Microsoft.Naming","CA1710:IdentifiersShouldHaveCorrectSuffix")>]
30073007
[<StructuralEquality; StructuralComparison>]
@@ -3040,10 +3040,10 @@ namespace Microsoft.FSharp.Collections
30403040
|[]->()
30413041
| h::t->
30423042
if i< nthen
3043-
SetArray items i h;
3043+
SetArray items i h
30443044
copy items t(i+1)
30453045

3046-
copy items l0;
3046+
copy items l0
30473047
items
30483048

30493049
typeResizeArray<'T>= System.Collections.Generic.List<'T>

‎src/fsharp/InnerLambdasToTopLevelFuncs.fs‎

Lines changed: 12 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -958,12 +958,16 @@ module Pass4_RewriteAssembly =
958958
#endif
959959

960960
/// Wrap preDecs (in order) over an expr - use letrec/let as approp
961-
letMakePreDec m(isRec,binds)expr=
961+
letMakePreDec m(isRec,binds:Bindings)expr=
962962
if isRec=IsRecthen
963-
mkLetRecBinds m binds expr
963+
// By definition top level bindings don't refer to non-top level bindings, so we can build them in two parts
964+
lettopLevelBinds,nonTopLevelBinds= binds|> List.partition(fun bind-> bind.Var.IsCompiledAsTopLevel)
965+
mkLetRecBinds m topLevelBinds(mkLetRecBinds m nonTopLevelBinds expr)
964966
else
965967
mkLetsFromBindings m binds expr
966968

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

969973
letRecursivePreDecs pdsA pdsB=
@@ -1099,11 +1103,6 @@ module Pass4_RewriteAssembly =
10991103
// pass4: pass (over expr)
11001104
//-------------------------------------------------------------------------
11011105

1102-
/// Must WrapPreDecs around every construct that could do EnterInner (which filters TLR decs).
1103-
/// i.e. let,letrec (bind may...), ilobj, lambda, tlambda.
1104-
letWrapPreDecs m pds x=
1105-
MakePreDecs m pds x
1106-
11071106
/// At bindings, fixup any TLR bindings.
11081107
/// At applications, fixup calls if they are arity-met instances of TLR.
11091108
/// At free vals, fixup 0-call if it is an arity-met constant.
@@ -1146,22 +1145,22 @@ module Pass4_RewriteAssembly =
11461145
(tType,objExprs'),z') z iimpls
11471146
letexpr= Expr.Obj(newUnique(),ty,basev,basecall,overrides,iimpls,m)
11481147
letpds,z= ExtractPreDecs z
1149-
WrapPreDecs m pds expr,z(* if TopLevel, lift preDecs over the ilobj expr*)
1148+
MakePreDecs m pds expr,z(* if TopLevel, lift preDecs over the ilobj expr*)
11501149

11511150
// lambda, tlambda - explicit lambda terms
11521151
| Expr.Lambda(_,ctorThisValOpt,baseValOpt,argvs,body,m,rty)->
11531152
letz= EnterInner z
11541153
letbody,z= TransExpr penv z body
11551154
letz= ExitInner z
11561155
letpds,z= ExtractPreDecs z
1157-
WrapPreDecs m pds(rebuildLambda m ctorThisValOpt baseValOpt argvs(body,rty)),z
1156+
MakePreDecs m pds(rebuildLambda m ctorThisValOpt baseValOpt argvs(body,rty)),z
11581157

11591158
| Expr.TyLambda(_,argtyvs,body,m,rty)->
11601159
letz= EnterInner z
11611160
letbody,z= TransExpr penv z body
11621161
letz= ExitInner z
11631162
letpds,z= ExtractPreDecs z
1164-
WrapPreDecs m pds(mkTypeLambda m argtyvs(body,rty)),z
1163+
MakePreDecs m pds(mkTypeLambda m argtyvs(body,rty)),z
11651164

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

11761175
// all others - below - rewrite structurally - so boiler plate code after this point...
11771176
| Expr.Const_-> expr,z(* constant wrt Val*)
@@ -1216,7 +1215,7 @@ module Pass4_RewriteAssembly =
12161215
// tailcall
12171216
TransLinearExpr penv z e(contf<<(fun(e,z)->
12181217
lete= mkLetsFromBindings m rebinds e
1219-
WrapPreDecs m pds(Expr.LetRec(binds,e,m,NewFreeVarsCache())),z))
1218+
MakePreDecs m pds(Expr.LetRec(binds,e,m,NewFreeVarsCache())),z))
12201219

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

12371236
| LinearMatchExpr(spBind,exprm,dtree,tg1,e2,sp2,m2,ty)->
12381237
letdtree,z= TransDecisionTree penv z dtree

‎src/fsharp/LowerCallsAndSeqs.fs‎

Lines changed: 72 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -179,6 +179,39 @@ let LowerSeqExpr g amap overallExpr =
179179
| Expr.App(Expr.Val(vref,_,_),_f0ty,[elemTy],[e],_m)when valRefEq g vref g.seq_vref-> Some(e,elemTy)
180180
|_-> None
181181

182+
letRepresentBindingAsStateMachineLocal(bind:Binding)res2 m=
183+
// printfn "found letrec state variable %s" bind.Var.DisplayName
184+
let(TBind(v,e,sp))= bind
185+
letsp,spm=
186+
match spwith
187+
| SequencePointAtBinding m-> SequencePointsAtSeq,m
188+
|_-> SuppressSequencePointOnExprOfSequential,e.Range
189+
letvref= mkLocalValRef v
190+
{ res2with
191+
phase2=(fun ctxt->
192+
letgenerate2,dispose2,checkDispose2= res2.phase2 ctxt
193+
letgenerate=
194+
mkCompGenSequential m
195+
(mkSequential sp m
196+
(mkValSet spm vref e)
197+
generate2)
198+
// zero out the current value to free up its memory
199+
(mkValSet m vref(mkDefault(m,vref.Type)))
200+
letdispose= dispose2
201+
letcheckDispose= checkDispose2
202+
generate,dispose,checkDispose)
203+
stateVars= vref::res2.stateVars}
204+
205+
letRepresentBindingsAsLifted mkBinds res2=
206+
// printfn "found top level let "
207+
{ res2with
208+
phase2=(fun ctxt->
209+
letgenerate2,dispose2,checkDispose2= res2.phase2 ctxt
210+
letgenerate= mkBinds generate2
211+
letdispose= dispose2
212+
letcheckDispose= checkDispose2
213+
generate,dispose, checkDispose)}
214+
182215
let recLower
183216
isWholeExpr
184217
isTailCall// is this sequence in tailcall position?
@@ -220,6 +253,7 @@ let LowerSeqExpr g amap overallExpr =
220253
| SeqDelay(e,_elemTy)->
221254
// printfn "found Seq.delay"
222255
Lower isWholeExpr isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel e// note, using 'isWholeExpr' here prevents 'seq { yield! e }' and 'seq { 0 .. 1000 }' from being compiled
256+
223257
| SeqAppend(e1,e2,m)->
224258
// printfn "found Seq.append"
225259
match Lowerfalsefalse noDisposeContinuationLabel currentDisposeContinuationLabel e1,
@@ -239,6 +273,7 @@ let LowerSeqExpr g amap overallExpr =
239273
significantClose= res1.significantClose|| res2.significantClose}
240274
|_->
241275
None
276+
242277
| SeqWhile(e1,e2,m)->
243278
// printfn "found Seq.while"
244279
match Lowerfalsefalse noDisposeContinuationLabel currentDisposeContinuationLabel e2with
@@ -254,9 +289,11 @@ let LowerSeqExpr g amap overallExpr =
254289
significantClose= res2.significantClose}
255290
|_->
256291
None
292+
257293
| SeqUsing(resource,v,body,elemTy,m)->
258294
// printfn "found Seq.using"
259295
Lowerfalse 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)))))
296+
260297
| SeqFor(inp,v,body,genElemTy,m)->
261298
// printfn "found Seq.for"
262299
letinpElemTy= v.Type
@@ -272,6 +309,7 @@ let LowerSeqExpr g amap overallExpr =
272309
(mkCallSeqGenerated g m genElemTy(mkUnitDelayLambda g m(callNonOverloadedMethod g amap m"MoveNext" inpEnumTy[enume]))
273310
(mkInvisibleLet m v(callNonOverloadedMethod g amap m"get_Current" inpEnumTy[enume])
274311
body))))
312+
275313
| SeqTryFinally(e1,compensation,m)->
276314
// printfn "found Seq.try/finally"
277315
letinnerDisposeContinuationLabel= IL.generateCodeLabel()
@@ -318,6 +356,7 @@ let LowerSeqExpr g amap overallExpr =
318356
significantClose=true}
319357
|_->
320358
None
359+
321360
| SeqEmpty m->
322361
// printfn "found Seq.empty"
323362
Some{ phase2=(fun _->
@@ -328,6 +367,7 @@ let LowerSeqExpr g amap overallExpr =
328367
labels=[]
329368
stateVars=[]
330369
significantClose=false}
370+
331371
| Expr.Sequential(x1,x2,NormalSeq,ty,m)->
332372
match Lowerfalse isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel x2with
333373
| Some res2->
@@ -343,41 +383,43 @@ let LowerSeqExpr g amap overallExpr =
343383

344384
| Expr.Let(bind,e2,m,_)
345385
// Restriction: compilation of sequence expressions containing non-toplevel constrained generic functions is not supported
346-
whennot bind.Var.IsCompiledAsTopLevel&&
347-
not(IsGenericValWithGenericContraints g bind.Var)->
386+
when bind.Var.IsCompiledAsTopLevel||not(IsGenericValWithGenericContraints g bind.Var)->
348387
match Lowerfalse isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel e2with
349388
| Some res2->
350389
if bind.Var.IsCompiledAsTopLevelthen
351-
// printfn "found top level let "
352-
Some{ res2with
353-
phase2=(fun ctxt->
354-
letgenerate2,dispose2,checkDispose2= res2.phase2 ctxt
355-
letgenerate= mkLetBind m bind generate2
356-
letdispose= dispose2
357-
letcheckDispose= checkDispose2
358-
generate,dispose, checkDispose)}
390+
Some(RepresentBindingsAsLifted(mkLetBind m bind) res2)
359391
else
360392
// printfn "found state variable %s" bind.Var.DisplayName
361-
let(TBind(v,e,sp))= bind
362-
letsp,spm=
363-
match spwith
364-
| SequencePointAtBinding m-> SequencePointsAtSeq,m
365-
|_-> SuppressSequencePointOnExprOfSequential,e.Range
366-
letvref= mkLocalValRef v
367-
Some{ res2with
368-
phase2=(fun ctxt->
369-
letgenerate2,dispose2,checkDispose2= res2.phase2 ctxt
370-
letgenerate=
371-
mkCompGenSequential m
372-
(mkSequential sp m
373-
(mkValSet spm vref e)
374-
generate2)
375-
// zero out the current value to free up its memory
376-
(mkValSet m vref(mkDefault(m,vref.Type)))
377-
letdispose= dispose2
378-
letcheckDispose= checkDispose2
379-
generate,dispose,checkDispose)
380-
stateVars= vref::res2.stateVars}
393+
Some(RepresentBindingAsStateMachineLocal bind res2 m)
394+
| None->
395+
None
396+
397+
| Expr.LetRec(binds,e2,m,_)
398+
when// Restriction: only limited forms of "let rec" in sequence expressions can be handled by assignment to state local values
399+
400+
(letrecvars= valsOfBinds binds|> List.map(fun v->(v,0))|> ValMap.OfList
401+
binds|> List.forall(fun bind->
402+
// Rule 1 - IsCompiledAsTopLevel require no state local value
403+
bind.Var.IsCompiledAsTopLevel||
404+
// Rule 2 - funky constrained local funcs not allowed
405+
not(IsGenericValWithGenericContraints g bind.Var))&&
406+
binds|> List.count(fun bind->
407+
// Rule 3 - Recursive non-lambda and repack values are allowed
408+
match stripExpr bind.Exprwith
409+
| Expr.Lambda_
410+
| Expr.TyLambda_->false
411+
// "let v = otherv" bindings get produced for environment packing by InnerLambdasToTopLevelFuncs.fs, we can accept and compiler these ok
412+
| Expr.Val(v,_,_)whennot(recvars.ContainsVal v.Deref)->false
413+
|_->true)<=1)->
414+
415+
match Lowerfalse isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel e2with
416+
| Some res2->
417+
lettopLevelBinds,nonTopLevelBinds= binds|> List.partition(fun bind-> bind.Var.IsCompiledAsTopLevel)
418+
// Represent the closure-capturing values as state machine locals. They may still be recursively-referential
419+
letres3=(res2,nonTopLevelBinds)||> List.fold(fun acc bind-> RepresentBindingAsStateMachineLocal bind acc m)
420+
// Represent the non-closure-capturing values as ordinary bindings on the expression.
421+
letres4=if topLevelBinds.IsEmptythen res3else RepresentBindingsAsLifted(mkLetRecBinds m topLevelBinds) res3
422+
Some res4
381423
| None->
382424
None
383425

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp