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

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

@@ -29,3 +29,4 @@
 * Reduce allocations in compiler checking via `ValueOption` usage ([PR #16323](https://github.com/dotnet/fsharp/pull/16323), [PR #16567](https://github.com/dotnet/fsharp/pull/16567))
 * 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))
+* Integral range optimizations. ([PR #16650](https://github.com/dotnet/fsharp/pull/16650))

src/Compiler/Optimize/LowerComputedCollections.fs

@@ -2,7 +2,7 @@
 
 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.InfoReader
@@ -255,18 +255,160 @@ 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 =
+    /// 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 expr =
+            let ty = stripMeasuresFromTy g (tyOfExpr g expr)
+
+            if typeEquiv g ty g.int64_ty then
+                mkAsmExpr ([AI_conv_ovf DT_I], [], [expr], [g.nativeint_ty], m)
+            elif typeEquiv g ty g.nativeint_ty then
+                mkAsmExpr ([AI_conv_ovf DT_I], [], [mkAsmExpr ([AI_conv DT_I8], [], [expr], [g.int64_ty], m)], [g.nativeint_ty], m)
+            elif typeEquiv g ty g.uint64_ty then
+                mkAsmExpr ([AI_conv_ovf_un DT_I], [], [expr], [g.nativeint_ty], m)
+            elif typeEquiv g ty g.unativeint_ty then
+                mkAsmExpr ([AI_conv_ovf_un DT_I], [], [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 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 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 ->
+                    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)) ->
+                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)) ->
+                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

@@ -809,6 +809,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))
@@ -1687,6 +1699,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