diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.400.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.400.md index 4203d7f41f8..fd28a3c2736 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.400.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.400.md @@ -1,5 +1,6 @@ ### Fixed +* Optimize simple mappings with preludes in computed collections. ([PR #17067](https://github.com/dotnet/fsharp/pull/17067)) * Improve error reporting for abstract members when used in classes. ([PR #17063](https://github.com/dotnet/fsharp/pull/17063)) * Improve error reporting when property has same name as DU case. ([Issue #16646](https://github.com/dotnet/fsharp/issues/16646), [PR #17088](https://github.com/dotnet/fsharp/pull/17088)) * Make typechecking of indexed setters with tuples on the right more consistent. ([Issue #16987](https://github.com/dotnet/fsharp/issues/16987), [PR #17017](https://github.com/dotnet/fsharp/pull/17017)) diff --git a/src/Compiler/Optimize/LowerComputedCollections.fs b/src/Compiler/Optimize/LowerComputedCollections.fs index 5d755daf4b1..2d2e02a9df3 100644 --- a/src/Compiler/Optimize/LowerComputedCollections.fs +++ b/src/Compiler/Optimize/LowerComputedCollections.fs @@ -11,8 +11,10 @@ open FSharp.Compiler.LowerSequenceExpressions open FSharp.Compiler.MethodCalls open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals +open FSharp.Compiler.Text open FSharp.Compiler.TypeRelations open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypeHierarchy @@ -257,8 +259,63 @@ let (|SeqToArray|_|) g expr = | _ -> ValueNone module List = + /// Makes the equivalent of an inlined call to List.map. + let mkMap tcVal (g: TcGlobals) amap m (mBody, spFor, _spIn, mFor, mIn, spInWhile) srcList overallElemTy loopVal body = + let collectorTy = g.mk_ListCollector_ty overallElemTy + let srcListTy = tyOfExpr g srcList + + mkCompGenLetMutableIn m "collector" collectorTy (mkDefault (m, collectorTy)) (fun (_, collector) -> + let reader = InfoReader (g, amap) + + // Adapted from DetectAndOptimizeForEachExpression in TypedTreeOps.fs. + + let IndexHead = 0 + let IndexTail = 1 + + let currentVar, currentExpr = mkMutableCompGenLocal mIn "current" srcListTy + let nextVar, nextExpr = mkMutableCompGenLocal mIn "next" srcListTy + let srcElemTy = loopVal.val_type + + let guardExpr = mkNonNullTest g mFor nextExpr + let headOrDefaultExpr = mkUnionCaseFieldGetUnprovenViaExprAddr (currentExpr, g.cons_ucref, [srcElemTy], IndexHead, mIn) + let tailOrNullExpr = mkUnionCaseFieldGetUnprovenViaExprAddr (currentExpr, g.cons_ucref, [srcElemTy], IndexTail, mIn) + + let body = + mkInvisibleLet mIn loopVal headOrDefaultExpr + (mkSequential mIn + (mkCallCollectorAdd tcVal g reader mIn collector body) + (mkSequential mIn + (mkValSet mIn (mkLocalValRef currentVar) nextExpr) + (mkValSet mIn (mkLocalValRef nextVar) tailOrNullExpr))) + + let loop = + // let mutable current = enumerableExpr + mkLet spFor m currentVar srcList + // let mutable next = current.TailOrNull + (mkInvisibleLet mFor nextVar tailOrNullExpr + // while nonNull next do + (mkWhile g (spInWhile, WhileLoopForCompiledForEachExprMarker, guardExpr, body, mBody))) + + let close = mkCallCollectorClose tcVal g reader m collector + + mkSequential m loop close + ) + /// Makes an expression that will build a list from an integral range. - let mkFromIntegralRange tcVal (g: TcGlobals) amap m rangeTy overallElemTy rangeExpr start step finish body = + let mkFromIntegralRange + tcVal + (g: TcGlobals) + amap + m + (mBody, _spFor, _spIn, mFor, mIn, spInWhile) + rangeTy + overallElemTy + (rangeExpr: Expr) + start + step + finish + (body: (Val * Expr) option) + = let collectorTy = g.mk_ListCollector_ty overallElemTy /// let collector = ListCollector () in @@ -275,15 +332,15 @@ module List = |> Option.map (fun (loopVal, body) -> mkInvisibleLet m loopVal loopVar body) |> Option.defaultValue loopVar - mkCallCollectorAdd tcVal g reader m collector body) + mkCallCollectorAdd tcVal g reader mBody collector body) - let close = mkCallCollectorClose tcVal g reader m collector + let close = mkCallCollectorClose tcVal g reader mBody collector mkSequential m loop close ) mkOptimizedRangeLoop g - (m, m, m, DebugPointAtWhile.No) + (mBody, mFor, mIn, spInWhile) (rangeTy, rangeExpr) (start, step, finish) (fun count mkLoop -> @@ -299,6 +356,78 @@ module List = ) module Array = + let private mkIlInstr (g: TcGlobals) specific any ilTy = + if ilTy = g.ilg.typ_Int32 then specific DT_I4 + elif ilTy = g.ilg.typ_Int64 then specific DT_I8 + elif ilTy = g.ilg.typ_UInt64 then specific DT_U8 + elif ilTy = g.ilg.typ_UInt32 then specific DT_U4 + elif ilTy = g.ilg.typ_IntPtr then specific DT_I + elif ilTy = g.ilg.typ_UIntPtr then specific DT_U + elif ilTy = g.ilg.typ_Int16 then specific DT_I2 + elif ilTy = g.ilg.typ_UInt16 then specific DT_U2 + elif ilTy = g.ilg.typ_SByte then specific DT_I1 + elif ilTy = g.ilg.typ_Byte then specific DT_U1 + elif ilTy = g.ilg.typ_Char then specific DT_U2 + elif ilTy = g.ilg.typ_Double then specific DT_R8 + elif ilTy = g.ilg.typ_Single then specific DT_R4 + else any ilTy + + /// Makes the equivalent of an inlined call to Array.map. + let mkMap g m (mBody, _spFor, _spIn, mFor, mIn, spInWhile) srcArray srcIlTy destIlTy overallElemTy loopVal body = + let len = mkLdlen g mIn srcArray + let arrayTy = mkArrayType g overallElemTy + + /// (# "newarr !0" type ('T) count : 'T array #) + let array = + mkAsmExpr + ( + [I_newarr (ILArrayShape.SingleDimensional, destIlTy)], + [], + [len], + [arrayTy], + m + ) + + let ldelem = mkIlInstr g I_ldelem (fun ilTy -> I_ldelem_any (ILArrayShape.SingleDimensional, ilTy)) srcIlTy + let stelem = mkIlInstr g I_stelem (fun ilTy -> I_stelem_any (ILArrayShape.SingleDimensional, ilTy)) destIlTy + + let mapping = + mkCompGenLetIn m (nameof array) arrayTy array (fun (_, array) -> + mkCompGenLetMutableIn mFor "i" g.int32_ty (mkTypedZero g mIn g.int32_ty) (fun (iVal, i) -> + let body = + // Rebind the loop val to pull directly from the source array. + let body = mkInvisibleLet mBody loopVal (mkAsmExpr ([ldelem], [], [srcArray; i], [loopVal.val_type], mBody)) body + + // destArray[i] <- body srcArray[i] + let setArrSubI = mkAsmExpr ([stelem], [], [array; i; body], [], mIn) + + // i <- i + 1 + let incrI = mkValSet mIn (mkLocalValRef iVal) (mkAsmExpr ([AI_add], [], [i; mkTypedOne g mIn g.int32_ty], [g.int32_ty], mIn)) + + mkSequential mIn setArrSubI incrI + + let guard = mkILAsmClt g mFor i (mkLdlen g mFor array) + + let loop = + mkWhile + g + ( + spInWhile, + NoSpecialWhileLoopMarker, + guard, + body, + mIn + ) + + // while i < array.Length do
done + // array + mkSequential m loop array + ) + ) + + // Add a debug point at the `for`, before anything gets evaluated. + Expr.DebugPoint (DebugPointAtLeafExpr.Yes mFor, mapping) + /// Whether to check for overflow when converting a value to a native int. [