Speed up for … in xs -> … in computed collections

docs/release-notes/.FSharp.Compiler.Service/8.0.300.md

@@ -56,4 +56,5 @@
 * Reverted [#16348](https://github.com/dotnet/fsharp/pull/16348) `ThreadStatic` `CancellationToken` changes to improve test stability and prevent potential unwanted cancellations. ([PR #16536](https://github.com/dotnet/fsharp/pull/16536))
 * Refactored parenthesization API. ([PR #16461])(https://github.com/dotnet/fsharp/pull/16461))
 * Optimize some interpolated strings by lowering to string concatenation. ([PR #16556](https://github.com/dotnet/fsharp/pull/16556))
+* Speed up `for x in xs -> …` in list & array comprehensions in certain scenarios. ([PR #16948](https://github.com/dotnet/fsharp/pull/16948))
 * Integral range optimizations. ([PR #16650](https://github.com/dotnet/fsharp/pull/16650), [PR #16832](https://github.com/dotnet/fsharp/pull/16832), [PR #16947](https://github.com/dotnet/fsharp/pull/16947))

docs/release-notes/.Language/preview.md

@@ -1,5 +1,6 @@
 ### Added
 
+* Speed up `for x in xs -> …` in list & array comprehensions in certain scenarios. ([PR #16948](https://github.com/dotnet/fsharp/pull/16948))
 * Lower integral ranges to fast loops in more cases and optimize list and array construction from ranges. ([PR #16650](https://github.com/dotnet/fsharp/pull/16650), [PR #16832](https://github.com/dotnet/fsharp/pull/16832))
 * Better generic unmanaged structs handling. ([Language suggestion #692](https://github.com/fsharp/fslang-suggestions/issues/692), [PR #12154](https://github.com/dotnet/fsharp/pull/12154))
 * Bidirectional F#/C# interop for 'unmanaged' constraint. ([PR #12154](https://github.com/dotnet/fsharp/pull/12154))

src/Compiler/FSComp.txt

@@ -1596,6 +1596,7 @@ featureBooleanReturningAndReturnTypeDirectedPartialActivePattern,"Boolean-return
 featureEnforceAttributeTargets,"Enforce AttributeTargets"
 featureLowerInterpolatedStringToConcat,"Optimizes interpolated strings in certain cases, by lowering to concatenation"
 featureLowerIntegralRangesToFastLoops,"Optimizes certain uses of the integral range (..) and range-step (.. ..) operators to fast while-loops."
+featureLowerSimpleMappingsInComprehensionsToDirectCallsToMap,"Lowers [for x in xs -> f x] and [|for x in xs -> f x|] to calls to List.map and Array.map when xs is a list or an array, respectively."
 3354,tcNotAFunctionButIndexerNamedIndexingNotYetEnabled,"This value supports indexing, e.g. '%s.[index]'. The syntax '%s[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation."
 3354,tcNotAFunctionButIndexerIndexingNotYetEnabled,"This expression supports indexing, e.g. 'expr.[index]'. The syntax 'expr[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation."
 3355,tcNotAnIndexerNamedIndexingNotYetEnabled,"The value '%s' is not a function and does not support index notation."

src/Compiler/Facilities/LanguageFeatures.fs

@@ -88,6 +88,7 @@ type LanguageFeature =
     | EnforceAttributeTargets
     | LowerInterpolatedStringToConcat
     | LowerIntegralRangesToFastLoops
+    | LowerSimpleMappingsInComprehensionsToDirectCallsToMap
 
 /// LanguageVersion management
 type LanguageVersion(versionText) =
@@ -203,6 +204,7 @@ type LanguageVersion(versionText) =
                 LanguageFeature.EnforceAttributeTargets, previewVersion
                 LanguageFeature.LowerInterpolatedStringToConcat, previewVersion
                 LanguageFeature.LowerIntegralRangesToFastLoops, previewVersion
+                LanguageFeature.LowerSimpleMappingsInComprehensionsToDirectCallsToMap, previewVersion
             ]
 
     static let defaultLanguageVersion = LanguageVersion("default")
@@ -349,6 +351,8 @@ type LanguageVersion(versionText) =
         | LanguageFeature.EnforceAttributeTargets -> FSComp.SR.featureEnforceAttributeTargets ()
         | LanguageFeature.LowerInterpolatedStringToConcat -> FSComp.SR.featureLowerInterpolatedStringToConcat ()
         | LanguageFeature.LowerIntegralRangesToFastLoops -> FSComp.SR.featureLowerIntegralRangesToFastLoops ()
+        | LanguageFeature.LowerSimpleMappingsInComprehensionsToDirectCallsToMap ->
+            FSComp.SR.featureLowerSimpleMappingsInComprehensionsToDirectCallsToMap ()
 
     /// Get a version string associated with the given feature.
     static member GetFeatureVersionString feature =

src/Compiler/Facilities/LanguageFeatures.fsi

@@ -79,6 +79,7 @@ type LanguageFeature =
     | EnforceAttributeTargets
     | LowerInterpolatedStringToConcat
     | LowerIntegralRangesToFastLoops
+    | LowerSimpleMappingsInComprehensionsToDirectCallsToMap
 
 /// LanguageVersion management
 type LanguageVersion =

src/Compiler/Optimize/LowerComputedCollections.fs

@@ -466,13 +466,29 @@ let (|SimpleMapping|_|) g expr =
 
     | _ -> ValueNone
 
+[<return: Struct>]
+let (|Array|_|) g (OptionalCoerce expr) =
+    if isArray1DTy g (tyOfExpr g expr) then ValueSome expr
+    else ValueNone
+
+[<return: Struct>]
+let (|List|_|) g (OptionalCoerce expr) =
+    if isListTy g (tyOfExpr g expr) then ValueSome expr
+    else ValueNone
+
 let LowerComputedListOrArrayExpr tcVal (g: TcGlobals) amap ilTyForTy overallExpr =
     // If ListCollector is in FSharp.Core then this optimization kicks in
     if g.ListCollector_tcr.CanDeref then
         match overallExpr with
         // […]
         | SeqToList g (OptionalCoerce (OptionalSeq g amap (overallSeqExpr, overallElemTy)), m) ->
             match overallSeqExpr with
+            // [for … in xs -> …] (* When xs is a list. *)
+            | SimpleMapping g (ty1, ty2, List g list, mapping, _, _) when
+                g.langVersion.SupportsFeature LanguageFeature.LowerSimpleMappingsInComprehensionsToDirectCallsToMap
+                ->
+                Some (mkCallListMap g m ty1 ty2 mapping list)
+
             // [start..finish]
             // [start..step..finish]
             | IntegralRange g (rangeTy, (start, step, finish)) when
@@ -495,6 +511,12 @@ let LowerComputedListOrArrayExpr tcVal (g: TcGlobals) amap ilTyForTy overallExpr
         // [|…|]
         | SeqToArray g (OptionalCoerce (OptionalSeq g amap (overallSeqExpr, overallElemTy)), m) ->
             match overallSeqExpr with
+            // [|for … in xs -> …|] (* When xs is an array. *)
+            | SimpleMapping g (ty1, ty2, Array g array, mapping, _, _) when
+                g.langVersion.SupportsFeature LanguageFeature.LowerSimpleMappingsInComprehensionsToDirectCallsToMap
+                ->
+                Some (mkCallArrayMap g m ty1 ty2 mapping array)
+
             // [|start..finish|]
             // [|start..step..finish|]
             | IntegralRange g (rangeTy, (start, step, finish)) when

src/Compiler/TypedTree/TcGlobals.fs

@@ -824,6 +824,7 @@ type TcGlobals(
   let v_range_step_generic_op_info = makeIntrinsicValRef(fslib_MFOperatorIntrinsics_nleref,                    "RangeStepGeneric"                     , None                 , None          , [vara;varb], ([[varaTy];[varbTy];[varaTy]], mkSeqTy varaTy))
 
   let v_array_length_info          = makeIntrinsicValRef(fslib_MFArrayModule_nleref,                           "length"                               , None                 , Some "Length" , [vara],     ([[mkArrayType 1 varaTy]], v_int_ty))
+  let v_array_map_info             = makeIntrinsicValRef(fslib_MFArrayModule_nleref,                           "map"                                  , None                 , Some "Map"    , [vara; varb], ([[varaTy --> varbTy]; [mkArrayType 1 varaTy]], mkArrayType 1 varbTy))
   let v_array_get_info             = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref,                    "GetArray"                             , None                 , None          , [vara],     ([[mkArrayType 1 varaTy]; [v_int_ty]], varaTy))
   let v_array2D_get_info           = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref,                    "GetArray2D"                           , None                 , None          , [vara],     ([[mkArrayType 2 varaTy];[v_int_ty]; [v_int_ty]], varaTy))
   let v_array3D_get_info           = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref,                    "GetArray3D"                           , None                 , None          , [vara],     ([[mkArrayType 3 varaTy];[v_int_ty]; [v_int_ty]; [v_int_ty]], varaTy))
@@ -833,6 +834,8 @@ type TcGlobals(
   let v_array3D_set_info           = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref,                    "SetArray3D"                           , None                 , None          , [vara],     ([[mkArrayType 3 varaTy];[v_int_ty]; [v_int_ty]; [v_int_ty]; [varaTy]], v_unit_ty))
   let v_array4D_set_info           = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref,                    "SetArray4D"                           , None                 , None          , [vara],     ([[mkArrayType 4 varaTy];[v_int_ty]; [v_int_ty]; [v_int_ty]; [v_int_ty]; [varaTy]], v_unit_ty))
 
+  let v_list_map_info              = makeIntrinsicValRef(fslib_MFListModule_nleref,                            "map"                                  , None                 , Some "Map"    , [vara; varb], ([[varaTy --> varbTy]; [mkListTy varaTy]], mkListTy varbTy))
+
   let v_option_toNullable_info     = makeIntrinsicValRef(fslib_MFOptionModule_nleref,                          "toNullable"                           , None                 , Some "ToNullable" , [vara],     ([[mkOptionTy varaTy]], mkNullableTy varaTy))
   let v_option_defaultValue_info   = makeIntrinsicValRef(fslib_MFOptionModule_nleref,                          "defaultValue"                         , None                 , Some "DefaultValue" , [vara],     ([[varaTy]; [mkOptionTy varaTy]], varaTy))
 
@@ -1715,9 +1718,11 @@ type TcGlobals(
   member val range_generic_op_vref      = ValRefForIntrinsic v_range_generic_op_info
   member val range_step_generic_op_vref = ValRefForIntrinsic v_range_step_generic_op_info
   member val array_get_vref             = ValRefForIntrinsic v_array_get_info
+  member val array_map_vref             = ValRefForIntrinsic v_array_map_info
   member val array2D_get_vref           = ValRefForIntrinsic v_array2D_get_info
   member val array3D_get_vref           = ValRefForIntrinsic v_array3D_get_info
   member val array4D_get_vref           = ValRefForIntrinsic v_array4D_get_info
+  member val list_map_vref              = ValRefForIntrinsic v_list_map_info
   member val seq_singleton_vref         = ValRefForIntrinsic v_seq_singleton_info
   member val seq_collect_vref           = ValRefForIntrinsic v_seq_collect_info
   member val nativeptr_tobyref_vref     = ValRefForIntrinsic v_nativeptr_tobyref_info
@@ -1778,6 +1783,7 @@ type TcGlobals(
   member _.seq_to_array_info          = v_seq_to_array_info
 
   member _.array_length_info          = v_array_length_info
+  member _.array_map_info             = v_array_map_info
   member _.array_get_info             = v_array_get_info
   member _.array2D_get_info           = v_array2D_get_info
   member _.array3D_get_info           = v_array3D_get_info
@@ -1787,6 +1793,8 @@ type TcGlobals(
   member _.array3D_set_info           = v_array3D_set_info
   member _.array4D_set_info           = v_array4D_set_info
 
+  member _.list_map_info              = v_list_map_info
+
   member val option_toNullable_info     = v_option_toNullable_info
   member val option_defaultValue_info     = v_option_defaultValue_info
 

src/Compiler/TypedTree/TypedTreeOps.fs

@@ -7795,6 +7795,8 @@ let mkCallArrayLength (g: TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g
 
 let mkCallArrayGet (g: TcGlobals) m ty e1 idx1 = mkApps g (typedExprForIntrinsic g m g.array_get_info, [[ty]], [ e1 ; idx1 ], m)
 
+let mkCallArrayMap (g: TcGlobals) m ty1 ty2 e1 e2 = mkApps g (typedExprForIntrinsic g m g.array_map_info, [[ty1; ty2]], [ e1 ; e2 ], m)
+
 let mkCallArray2DGet (g: TcGlobals) m ty e1 idx1 idx2 = mkApps g (typedExprForIntrinsic g m g.array2D_get_info, [[ty]], [ e1 ; idx1; idx2 ], m)
 
 let mkCallArray3DGet (g: TcGlobals) m ty e1 idx1 idx2 idx3 = mkApps g (typedExprForIntrinsic g m g.array3D_get_info, [[ty]], [ e1 ; idx1; idx2; idx3 ], m)
@@ -7809,6 +7811,8 @@ let mkCallArray3DSet (g: TcGlobals) m ty e1 idx1 idx2 idx3 v = mkApps g (typedEx
 
 let mkCallArray4DSet (g: TcGlobals) m ty e1 idx1 idx2 idx3 idx4 v = mkApps g (typedExprForIntrinsic g m g.array4D_set_info, [[ty]], [ e1 ; idx1; idx2; idx3; idx4; v ], m)
 
+let mkCallListMap (g: TcGlobals) m ty1 ty2 e1 e2 = mkApps g (typedExprForIntrinsic g m g.list_map_info, [[ty1; ty2]], [ e1 ; e2 ], m)
+
 let mkCallHash (g: TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.hash_info, [[ty]], [ e1 ], m)
 
 let mkCallBox (g: TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.box_info, [[ty]], [ e1 ], m)

src/Compiler/TypedTree/TypedTreeOps.fsi

@@ -2036,6 +2036,8 @@ val mkCallArrayLength: TcGlobals -> range -> TType -> Expr -> Expr
 
 val mkCallArrayGet: TcGlobals -> range -> TType -> Expr -> Expr -> Expr
 
+val mkCallArrayMap: g: TcGlobals -> m: range -> ty1: TType -> ty2: TType -> e1: Expr -> e2: Expr -> Expr
+
 val mkCallArray2DGet: TcGlobals -> range -> TType -> Expr -> Expr -> Expr -> Expr
 
 val mkCallArray3DGet: TcGlobals -> range -> TType -> Expr -> Expr -> Expr -> Expr -> Expr
@@ -2050,6 +2052,8 @@ val mkCallArray3DSet: TcGlobals -> range -> TType -> Expr -> Expr -> Expr -> Exp
 
 val mkCallArray4DSet: TcGlobals -> range -> TType -> Expr -> Expr -> Expr -> Expr -> Expr -> Expr -> Expr
 
+val mkCallListMap: g: TcGlobals -> m: range -> ty1: TType -> ty2: TType -> e1: Expr -> e2: Expr -> Expr
+
 val mkCallHash: TcGlobals -> range -> TType -> Expr -> Expr
 
 val mkCallBox: TcGlobals -> range -> TType -> Expr -> Expr