diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 3ea19645b6..25414dbc62 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -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 @@ -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 diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index 0e126f3469..15cbc553a8 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -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 = @@ -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