Skip to content
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
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
90 changes: 89 additions & 1 deletion src/fsharp/Optimizer.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2567,7 +2567,21 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m)

//-------------------------------------------------------------------------
// Optimize/analyze an application of a function to type and term arguments
//-------------------------------------------------------------------------
//-------------------------------------------------------------------------

and IterExpression vref cenv expr =
match expr with
| Expr.App(Expr.Val(valRef,_,_rangeIter), _, [TType_app _ as elementType], appliedParams, _rangeOuter)
when valRefEq cenv.g valRef vref ->
match appliedParams with
| [Expr.Lambda(_,None,None,[fVal],fBody,_m1,_fRetType);
source] -> Some(source, elementType, fVal, fBody)
| _ -> None
| _ -> None

and (|ListIterExpression|_|) cenv expr = IterExpression cenv.g.list_iter_vref cenv expr
and (|SeqIterExpression|_|) cenv expr = IterExpression cenv.g.seq_iter_vref cenv expr
and (|ArrayIterExpression|_|) cenv expr = IterExpression cenv.g.array_iter_vref cenv expr

and OptimizeApplication cenv env (f0, f0ty, tyargs, args, m) =
// trying to devirtualize
Expand Down Expand Up @@ -2610,6 +2624,80 @@ and OptimizeApplication cenv env (f0, f0ty, tyargs, args, m) =
// we beta-reduced, hence reoptimize
OptimizeExpr cenv env newExpr
| _ ->
match newExpr with
// Rewrite 'List.iter (fun x -> expr) s' into 'for x in s do expr'
| ListIterExpression cenv (enumerableExpr, elemTy, elemVar, bodyExpr) ->
let g = cenv.g
let enumExprTy = mkListTy g elemTy
let zeroRange = range.Zero
// copy pasted from TastOps: DetectAndOptimizeForExpression
let IndexHead = 0
let IndexTail = 1

let currentVar , currentExpr = mkMutableCompGenLocal zeroRange "current" enumExprTy
let nextVar , nextExpr = mkMutableCompGenLocal zeroRange "next" enumExprTy

let guardExpr = mkNonNullTest g zeroRange nextExpr
let headOrDefaultExpr = mkUnionCaseFieldGetUnprovenViaExprAddr (currentExpr, g.cons_ucref, [elemTy], IndexHead, zeroRange)
let tailOrNullExpr = mkUnionCaseFieldGetUnprovenViaExprAddr (currentExpr, g.cons_ucref, [elemTy], IndexTail, zeroRange)
let bodyExpr =
mkCompGenLet zeroRange elemVar headOrDefaultExpr
(mkCompGenSequential zeroRange
bodyExpr
(mkCompGenSequential zeroRange
(mkValSet zeroRange (mkLocalValRef currentVar) nextExpr)
(mkValSet zeroRange (mkLocalValRef nextVar) tailOrNullExpr)
)
)

let expr =
// let mutable current = enumerableExpr
mkLet NoSequencePointAtStickyBinding zeroRange currentVar enumerableExpr
// let mutable next = current.TailOrNull
(mkCompGenLet zeroRange nextVar tailOrNullExpr
// while nonNull next dp
(mkWhile g (NoSequencePointAtWhileLoop, WhileLoopForCompiledForEachExprMarker, guardExpr, bodyExpr, zeroRange)))

OptimizeExpr cenv env expr


// Rewrite 'Seq.iter (fun x -> expr) s' into 'for x in s do expr'
| SeqIterExpression cenv _ when false ->
failwith "not implemented"
//let g = cenv.g
//let enumExprTy = mkListTy g elemTy
//let zeroRange = range.Zero

//let enumExpr = enumerableExpr
//let mForLoopStart = zeroRange
//let mEnumExpr = zeroRange
//let spForLoop = NoSequencePointAtForLoop
//// ---------
//let enumerableVar, enumerableExprInVar = mkCompGenLocal mEnumExpr "inputSequence" enumExprTy
//let enumeratorVar, enumeratorExpr, _, enumElemTy, getEnumExpr, getEnumTy, guardExpr, _, currentExpr =
// TypeChecker.AnalyzeArbitraryExprAsEnumerable cenv env true mEnumExpr enumExprTy enumerableExprInVar
//let expr =
// // This compiled for must be matched EXACTLY by CompiledForEachExpr in opt.fs and creflect.fs
// mkCompGenLet mForLoopStart enumerableVar enumExpr
// (let cleanupE = TypeChecker.BuildDisposableCleanup cenv env mWholeExpr enumeratorVar
// let spBind = match spForLoop with SequencePointAtForLoop(spStart) -> SequencePointAtBinding(spStart) | NoSequencePointAtForLoop -> NoSequencePointAtStickyBinding
// (mkLet spBind mForLoopStart enumeratorVar getEnumExpr
// (mkTryFinally cenv.g
// (mkWhile cenv.g
// (NoSequencePointAtWhileLoop,
// WhileLoopForCompiledForEachExprMarker, guardExpr,
// mkCompGenLet mForLoopStart elemVar currentExpr bodyExpr,
// mForLoopStart),
// cleanupE, mForLoopStart, cenv.g.unit_ty, NoSequencePointAtTry, NoSequencePointAtFinally))))

//OptimizeExpr cenv env expr

// Rewrite 'Array.iter (fun x -> expr) s' into 'for x in s do expr'
| ArrayIterExpression cenv _ when false ->
failwith "not implemented"

| _ ->

// regular

// Determine if this application is a critical tailcall
Expand Down
8 changes: 8 additions & 0 deletions src/fsharp/TcGlobals.fs
Original file line number Diff line number Diff line change
Expand Up @@ -592,6 +592,9 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
let v_seq_map_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "map" , None , Some "Map" , [vara;varb], ([[varaTy --> varbTy]; [mkSeqTy varaTy]], mkSeqTy varbTy))
let v_seq_singleton_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "singleton" , None , Some "Singleton" , [vara], ([[varaTy]], mkSeqTy varaTy))
let v_seq_empty_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "empty" , None , Some "Empty" , [vara], ([], mkSeqTy varaTy))
let v_seq_iter_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "iter" , None , Some "Iterate" , [varb], ([[mkSeqTy varbTy]], v_unit_ty))
let v_list_iter_info = makeIntrinsicValRef(fslib_MFListModule_nleref, "iter" , None , Some "Iterate" , [varb], ([[mkListTy varbTy]], v_unit_ty))
let v_array_iter_info = makeIntrinsicValRef(fslib_MFArrayModule_nleref, "iter" , None , Some "Iterate" , [varb], ([[mkArrayType 1 varbTy]], v_unit_ty))
let v_new_format_info = makeIntrinsicValRef(fslib_MFCore_nleref, ".ctor" , Some "PrintfFormat`5", None , [vara;varb;varc;vard;vare], ([[v_string_ty]], mkPrintfFormatTy varaTy varbTy varcTy vardTy vareTy))
let v_sprintf_info = makeIntrinsicValRef(fslib_MFExtraTopLevelOperators_nleref, "sprintf" , None , Some "PrintFormatToStringThen", [vara], ([[mk_format4_ty varaTy v_unit_ty v_string_ty v_string_ty]], varaTy))
let v_lazy_force_info =
Expand Down Expand Up @@ -1149,6 +1152,11 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
member val seq_of_functions_vref = ValRefForIntrinsic v_seq_of_functions_info
member val seq_map_vref = ValRefForIntrinsic v_seq_map_info
member val seq_empty_vref = ValRefForIntrinsic v_seq_empty_info
//--
member val seq_iter_vref = ValRefForIntrinsic v_seq_iter_info
member val list_iter_vref = ValRefForIntrinsic v_list_iter_info
member val array_iter_vref = ValRefForIntrinsic v_array_iter_info
//--
member val new_format_vref = ValRefForIntrinsic v_new_format_info
member val sprintf_vref = ValRefForIntrinsic v_sprintf_info
member val unbox_vref = ValRefForIntrinsic v_unbox_info
Expand Down