Better integral range lowering: start..finish, start..step..finish

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

@@ -36,3 +36,4 @@
 * 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))
+* Integral range optimizations. ([PR #16650](https://github.com/dotnet/fsharp/pull/16650))

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

@@ -1,5 +1,6 @@
 ### Added
 
+* 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))
 * 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))
 * Make `.Is*` discriminated union properties visible. ([Language suggestion #222](https://github.com/fsharp/fslang-suggestions/issues/222), [PR #16341](https://github.com/dotnet/fsharp/pull/16341))

src/Compiler/FSComp.txt

@@ -1597,6 +1597,7 @@ featureBooleanReturningAndReturnTypeDirectedPartialActivePattern,"Boolean-return
 featureEnforceAttributeTargetsOnFunctions,"Enforce AttributeTargets on functions"
 featureEnforceAttributeTargetsUnionCaseDeclarations,"Enforce AttributeTargets on union case declarations"
 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."
 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 =
     | EnforceAttributeTargetsOnFunctions
     | EnforceAttributeTargetsUnionCaseDeclarations
     | LowerInterpolatedStringToConcat
+    | LowerIntegralRangesToFastLoops
 
 /// LanguageVersion management
 type LanguageVersion(versionText) =
@@ -203,6 +204,7 @@ type LanguageVersion(versionText) =
                 LanguageFeature.EnforceAttributeTargetsOnFunctions, previewVersion
                 LanguageFeature.EnforceAttributeTargetsUnionCaseDeclarations, previewVersion
                 LanguageFeature.LowerInterpolatedStringToConcat, previewVersion
+                LanguageFeature.LowerIntegralRangesToFastLoops, previewVersion
             ]
 
     static let defaultLanguageVersion = LanguageVersion("default")
@@ -349,6 +351,7 @@ type LanguageVersion(versionText) =
         | LanguageFeature.EnforceAttributeTargetsOnFunctions -> FSComp.SR.featureEnforceAttributeTargetsOnFunctions ()
         | LanguageFeature.EnforceAttributeTargetsUnionCaseDeclarations -> FSComp.SR.featureEnforceAttributeTargetsUnionCaseDeclarations ()
         | LanguageFeature.LowerInterpolatedStringToConcat -> FSComp.SR.featureLowerInterpolatedStringToConcat ()
+        | LanguageFeature.LowerIntegralRangesToFastLoops -> FSComp.SR.featureLowerIntegralRangesToFastLoops ()
 
     /// Get a version string associated with the given feature.
     static member GetFeatureVersionString feature =

src/Compiler/Facilities/LanguageFeatures.fsi

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

src/Compiler/Optimize/LowerComputedCollections.fs

@@ -2,9 +2,10 @@
 
 module internal FSharp.Compiler.LowerComputedCollectionExpressions
 
-open Internal.Utilities.Library
+open FSharp.Compiler.AbstractIL.IL
 open FSharp.Compiler.AccessibilityLogic
 open FSharp.Compiler.DiagnosticsLogger
+open FSharp.Compiler.Features
 open FSharp.Compiler.InfoReader
 open FSharp.Compiler.LowerSequenceExpressions
 open FSharp.Compiler.MethodCalls
@@ -255,18 +256,178 @@ let (|SeqToArray|_|) g expr =
     | ValApp g g.seq_to_array_vref (_, [seqExpr], m) -> ValueSome (seqExpr, m)
     | _ -> ValueNone
 
+module List =
+    /// Makes an expression that will build a list from an integral range.
+    let mkFromIntegralRange tcVal (g: TcGlobals) amap m overallElemTy overallSeqExpr start step finish =
+        let collectorTy = g.mk_ListCollector_ty overallElemTy
+
+        /// let collector = ListCollector () in
+        /// <initialization loop>
+        /// collector.Close ()
+        let mkListInit mkLoop =
+            mkCompGenLetMutableIn m "collector" collectorTy (mkDefault (m, collectorTy)) (fun (_, collector) ->
+                let reader = InfoReader (g, amap)
+                let loop = mkLoop (fun _idxVar loopVar -> mkCallCollectorAdd tcVal g reader m collector loopVar)
+                let close = mkCallCollectorClose tcVal g reader m collector
+                mkSequential m loop close
+            )
+
+        mkOptimizedRangeLoop
+            g
+            (m, m, m, DebugPointAtWhile.No)
+            (overallElemTy, overallSeqExpr)
+            (start, step, finish)
+            (fun count mkLoop ->
+                match count with
+                | Expr.Const (value = IntegralConst.Zero) ->
+                    mkNil g m overallElemTy
+
+                | Expr.Const (value = _nonzeroConstant) ->
+                    mkListInit mkLoop
+
+                | _dynamicCount ->
+                    mkListInit mkLoop
+            )
+
+module Array =
+    /// Whether to check for overflow when converting a value to a native int.
+    [<NoEquality; NoComparison>]
+    type Ovf =
+        /// Check for overflow. We need this when passing the count into newarr.
+        | CheckOvf
+
+        /// Don't check for overflow. We don't need to check when indexing into the array,
+        /// since we already know count didn't overflow during initialization.
+        | NoCheckOvf
+
+    /// Makes an expression that will build an array from an integral range.
+    let mkFromIntegralRange g m overallElemTy overallSeqExpr start step finish =
+        let arrayTy = mkArrayType g overallElemTy
+
+        let convToNativeInt ovf expr =
+            let ty = stripMeasuresFromTy g (tyOfExpr g expr)
+
+            let conv =
+                match ovf with
+                | NoCheckOvf -> AI_conv DT_I
+                | CheckOvf when isSignedIntegerTy g ty -> AI_conv_ovf DT_I
+                | CheckOvf -> AI_conv_ovf_un DT_I
+
+            if typeEquiv g ty g.int64_ty then
+                mkAsmExpr ([conv], [], [expr], [g.nativeint_ty], m)
+            elif typeEquiv g ty g.nativeint_ty then
+                mkAsmExpr ([conv], [], [mkAsmExpr ([AI_conv DT_I8], [], [expr], [g.int64_ty], m)], [g.nativeint_ty], m)
+            elif typeEquiv g ty g.uint64_ty then
+                mkAsmExpr ([conv], [], [expr], [g.nativeint_ty], m)
+            elif typeEquiv g ty g.unativeint_ty then
+                mkAsmExpr ([conv], [], [mkAsmExpr ([AI_conv DT_U8], [], [expr], [g.uint64_ty], m)], [g.nativeint_ty], m)
+            else
+                expr
+
+        let ilTy, ilBasicTy =
+            let ty = stripMeasuresFromTy g overallElemTy
+
+            if typeEquiv g ty g.int32_ty then g.ilg.typ_Int32, DT_I4
+            elif typeEquiv g ty g.int64_ty then g.ilg.typ_Int64, DT_I8
+            elif typeEquiv g ty g.uint64_ty then g.ilg.typ_UInt64, DT_U8
+            elif typeEquiv g ty g.uint32_ty then g.ilg.typ_UInt32, DT_U4
+            elif typeEquiv g ty g.nativeint_ty then g.ilg.typ_IntPtr, DT_I
+            elif typeEquiv g ty g.unativeint_ty then g.ilg.typ_UIntPtr, DT_U
+            elif typeEquiv g ty g.int16_ty then g.ilg.typ_Int16, DT_I2
+            elif typeEquiv g ty g.uint16_ty then g.ilg.typ_UInt16, DT_U2
+            elif typeEquiv g ty g.sbyte_ty then g.ilg.typ_SByte, DT_I1
+            elif typeEquiv g ty g.byte_ty then g.ilg.typ_Byte, DT_U1
+            elif typeEquiv g ty g.char_ty then g.ilg.typ_Char, DT_U2
+            else error (InternalError ($"Unable to find IL type for integral type '{overallElemTy}'.", m))
+
+        /// (# "newarr !0" type ('T) count : 'T array #)
+        let mkNewArray count =
+            mkAsmExpr
+                (
+                    [I_newarr (ILArrayShape.SingleDimensional, ilTy)],
+                    [],
+                    [convToNativeInt CheckOvf count],
+                    [arrayTy],
+                    m
+                )
+
+        /// let array = (# "newarr !0" type ('T) count : 'T array #) in
+        /// <initialization loop>
+        /// array
+        let mkArrayInit count mkLoop =
+            mkCompGenLetIn m "array" arrayTy (mkNewArray count) (fun (_, array) ->
+                let loop = mkLoop (fun idxVar loopVar -> mkAsmExpr ([I_stelem ilBasicTy], [], [array; convToNativeInt NoCheckOvf idxVar; loopVar], [], m))
+                mkSequential m loop array)
+
+        mkOptimizedRangeLoop
+            g
+            (m, m, m, DebugPointAtWhile.No)
+            (overallElemTy, overallSeqExpr)
+            (start, step, finish)
+            (fun count mkLoop ->
+                match count with
+                | Expr.Const (value = IntegralConst.Zero) ->
+                    mkArray (overallElemTy, [], m)
+
+                | Expr.Const (value = _nonzeroConstant) ->
+                    mkArrayInit count mkLoop
+
+                | _dynamicCount ->
+                    mkCompGenLetIn m (nameof count) (tyOfExpr g count) count (fun (_, count) ->
+                        let countTy = tyOfExpr g count
+
+                        // count < 1
+                        let countLtOne =
+                            if isSignedIntegerTy g countTy then
+                                mkILAsmClt g m count (mkTypedOne g m countTy)
+                            else
+                                mkAsmExpr ([AI_clt_un], [], [count; mkTypedOne g m countTy], [g.bool_ty], m)
+
+                        // if count < 1 then
+                        //     [||]
+                        // else
+                        //     let array = (# "newarr !0" type ('T) count : 'T array #) in
+                        //     <initialization loop>
+                        //     array
+                        mkCond
+                            DebugPointAtBinding.NoneAtInvisible
+                            m
+                            arrayTy
+                            countLtOne
+                            (mkArray (overallElemTy, [], m))
+                            (mkArrayInit count mkLoop)
+                    )
+            )
+
 let LowerComputedListOrArrayExpr tcVal (g: TcGlobals) amap 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) ->
-            let collectorTy = g.mk_ListCollector_ty overallElemTy
-            LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr
-
+            match overallSeqExpr with
+            // [start..finish]
+            // [start..step..finish]
+            | IntegralRange g (_, (start, step, finish)) when g.langVersion.SupportsFeature LanguageFeature.LowerIntegralRangesToFastLoops ->
+                Some (List.mkFromIntegralRange tcVal g amap m overallElemTy overallSeqExpr start step finish)
+
+            // [(* Anything more complex. *)]
+            | _ ->
+                let collectorTy = g.mk_ListCollector_ty overallElemTy
+                LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr
+
+        // [|…|]
         | SeqToArray g (OptionalCoerce (OptionalSeq g amap (overallSeqExpr, overallElemTy)), m) ->
-            let collectorTy = g.mk_ArrayCollector_ty overallElemTy
-            LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr
+            match overallSeqExpr with
+            // [|start..finish|]
+            // [|start..step..finish|]
+            | IntegralRange g (_, (start, step, finish)) when g.langVersion.SupportsFeature LanguageFeature.LowerIntegralRangesToFastLoops ->
+                Some (Array.mkFromIntegralRange g m overallElemTy overallSeqExpr start step finish)
+
+            // [|(* Anything more complex. *)|]
+            | _ ->
+                let collectorTy = g.mk_ArrayCollector_ty overallElemTy
+                LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr
 
         | _ -> None
     else

src/Compiler/TypedTree/TcGlobals.fs

@@ -810,6 +810,18 @@ type TcGlobals(
   let v_range_op_info              = makeIntrinsicValRef(fslib_MFOperators_nleref,                             "op_Range"                             , None                 , None          , [vara],     ([[varaTy];[varaTy]], mkSeqTy varaTy))
   let v_range_step_op_info         = makeIntrinsicValRef(fslib_MFOperators_nleref,                             "op_RangeStep"                         , None                 , None          , [vara;varb], ([[varaTy];[varbTy];[varaTy]], mkSeqTy varaTy))
   let v_range_int32_op_info        = makeIntrinsicValRef(fslib_MFOperatorIntrinsics_nleref,                    "RangeInt32"                           , None                 , None          , [],     ([[v_int_ty];[v_int_ty];[v_int_ty]], mkSeqTy v_int_ty))
+  let v_range_int64_op_info        = makeIntrinsicValRef(fslib_MFOperatorIntrinsics_nleref,                    "RangeInt64"                           , None                 , None          , [],     ([[v_int64_ty];[v_int64_ty];[v_int64_ty]], mkSeqTy v_int64_ty))
+  let v_range_uint64_op_info       = makeIntrinsicValRef(fslib_MFOperatorIntrinsics_nleref,                    "RangeUInt64"                          , None                 , None          , [],     ([[v_uint64_ty];[v_uint64_ty];[v_uint64_ty]], mkSeqTy v_uint64_ty))
+  let v_range_uint32_op_info       = makeIntrinsicValRef(fslib_MFOperatorIntrinsics_nleref,                    "RangeUInt32"                          , None                 , None          , [],     ([[v_uint32_ty];[v_uint32_ty];[v_uint32_ty]], mkSeqTy v_uint32_ty))
+  let v_range_nativeint_op_info    = makeIntrinsicValRef(fslib_MFOperatorIntrinsics_nleref,                    "RangeIntPtr"                          , None                 , None          , [],     ([[v_nativeint_ty];[v_nativeint_ty];[v_nativeint_ty]], mkSeqTy v_nativeint_ty))
+  let v_range_unativeint_op_info   = makeIntrinsicValRef(fslib_MFOperatorIntrinsics_nleref,                    "RangeUIntPtr"                         , None                 , None          , [],     ([[v_unativeint_ty];[v_unativeint_ty];[v_unativeint_ty]], mkSeqTy v_unativeint_ty))
+  let v_range_int16_op_info        = makeIntrinsicValRef(fslib_MFOperatorIntrinsics_nleref,                    "RangeInt16"                           , None                 , None          , [],     ([[v_int16_ty];[v_int16_ty];[v_int16_ty]], mkSeqTy v_int16_ty))
+  let v_range_uint16_op_info       = makeIntrinsicValRef(fslib_MFOperatorIntrinsics_nleref,                    "RangeUInt16"                          , None                 , None          , [],     ([[v_uint16_ty];[v_uint16_ty];[v_uint16_ty]], mkSeqTy v_uint16_ty))
+  let v_range_sbyte_op_info        = makeIntrinsicValRef(fslib_MFOperatorIntrinsics_nleref,                    "RangeSByte"                           , None                 , None          , [],     ([[v_sbyte_ty];[v_sbyte_ty];[v_sbyte_ty]], mkSeqTy v_sbyte_ty))
+  let v_range_byte_op_info         = makeIntrinsicValRef(fslib_MFOperatorIntrinsics_nleref,                    "RangeByte"                            , None                 , None          , [],     ([[v_byte_ty];[v_byte_ty];[v_byte_ty]], mkSeqTy v_byte_ty))
+  let v_range_char_op_info         = makeIntrinsicValRef(fslib_MFOperatorIntrinsics_nleref,                    "RangeChar"                            , None                 , None          , [],     ([[v_char_ty];[v_char_ty];[v_char_ty]], mkSeqTy v_char_ty))
+  let v_range_generic_op_info      = makeIntrinsicValRef(fslib_MFOperatorIntrinsics_nleref,                    "RangeGeneric"                         , None                 , None          , [vara],      ([[varaTy];[varaTy]], mkSeqTy varaTy))
+  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_get_info             = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref,                    "GetArray"                             , None                 , None          , [vara],     ([[mkArrayType 1 varaTy]; [v_int_ty]], varaTy))
@@ -1690,6 +1702,18 @@ type TcGlobals(
   member val range_op_vref              = ValRefForIntrinsic v_range_op_info
   member val range_step_op_vref         = ValRefForIntrinsic v_range_step_op_info
   member val range_int32_op_vref        = ValRefForIntrinsic v_range_int32_op_info
+  member val range_int64_op_vref        = ValRefForIntrinsic v_range_int64_op_info
+  member val range_uint64_op_vref       = ValRefForIntrinsic v_range_uint64_op_info
+  member val range_uint32_op_vref       = ValRefForIntrinsic v_range_uint32_op_info
+  member val range_nativeint_op_vref    = ValRefForIntrinsic v_range_nativeint_op_info
+  member val range_unativeint_op_vref   = ValRefForIntrinsic v_range_unativeint_op_info
+  member val range_int16_op_vref        = ValRefForIntrinsic v_range_int16_op_info
+  member val range_uint16_op_vref       = ValRefForIntrinsic v_range_uint16_op_info
+  member val range_sbyte_op_vref        = ValRefForIntrinsic v_range_sbyte_op_info
+  member val range_byte_op_vref         = ValRefForIntrinsic v_range_byte_op_info
+  member val range_char_op_vref         = ValRefForIntrinsic v_range_char_op_info
+  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 array2D_get_vref           = ValRefForIntrinsic v_array2D_get_info
   member val array3D_get_vref           = ValRefForIntrinsic v_array3D_get_info