fix(all): read more for loop bounds once like .NET

src/Fable.Transforms/Babel/Fable2Babel.fs

@@ -1153,55 +1153,6 @@ module Util =
     let getUniqueNameInDeclarationScope (ctx: Context) name =
         getUniqueNameInDeclarationScopeWith ctx (fun _ -> false) name
 
-    let rec isStableForLoopLimit (limit: Fable.Expr) =
-        match limit with
-        | Fable.Value(Fable.NumberConstant _, _) -> true
-        | Fable.IdentExpr ident -> not ident.IsMutable
-        | Fable.Get(Fable.IdentExpr ident, Fable.FieldGet info, _, _) when info.Name = "length" ->
-            match ident.Type with
-            | Fable.String
-            | Fable.Array(_, (Fable.MutableArray | Fable.ImmutableArray)) -> not ident.IsMutable
-            | _ -> false
-        | Fable.Operation(Fable.Unary(_, operand), _, _, _) -> isStableForLoopLimit operand
-        | Fable.Operation(Fable.Binary(_, left, right), _, _, _) ->
-            isStableForLoopLimit left && isStableForLoopLimit right
-        | _ -> false
-
-    let private isMutableArrayLength (com: Compiler) (expr: Fable.Expr) =
-        let isArray =
-            function
-            | Fable.Array(_, (Fable.MutableArray | Fable.ImmutableArray)) -> true
-            | _ -> false
-
-        let isGetterCall (callInfo: Fable.CallInfo) =
-            Option.isNone callInfo.ThisArg && List.isEmpty callInfo.Args
-
-        match expr with
-        | Fable.Get(Fable.IdentExpr ident, Fable.FieldGet info, _, _) when info.Name = "length" ->
-            ident.IsMutable && isArray ident.Type
-        | Fable.Get(Fable.Call(Fable.IdentExpr ident, callInfo, _, _), Fable.FieldGet info, _, _) when
-            info.Name = "length" && isGetterCall callInfo
-            ->
-            ident.IsMutable && isArray ident.Type
-        | Fable.Get(Fable.Call(Fable.Import({ Kind = Fable.MemberImport memberRef }, _, _), callInfo, typ, _),
-                    Fable.FieldGet info,
-                    _,
-                    _) when info.Name = "length" && isGetterCall callInfo && isArray typ ->
-            match com.TryGetMember(memberRef) with
-            | Some memb -> memb.IsValue && memb.IsMutable
-            | None -> false
-        | _ -> false
-
-    let isReReadForLoopLimit (com: Compiler) isUp (limit: Fable.Expr) =
-        match limit with
-        | Fable.Operation(Fable.Binary(BinaryMinus,
-                                       length,
-                                       Fable.Value(Fable.NumberConstant(Fable.NumberValue.Int32 1, _), _)),
-                          _,
-                          _,
-                          _) when isUp -> isMutableArrayLength com length
-        | _ -> false
-
     type NamedTailCallOpportunity(_com: Compiler, ctx, name, args: Fable.Ident list) =
         // Capture the current argument values to prevent delayed references from getting corrupted,
         // for that we use block-scoped ES2015 variable declarations. See #681, #1859

src/Fable.Transforms/Beam/Fable2Beam.Util.fs

@@ -9,6 +9,16 @@ open Fable.Beam
 let toErlangVar (ident: Ident) =
     Naming.capitalizeFirst ident.Name |> Naming.sanitizeErlangVar
 
+let tryGetArrayOfLength (expr: Expr) =
+    match expr with
+    | Emit({
+               Macro = "erlang:length(erlang:get($0))" | "fable_utils:byte_array_length($0)"
+               CallInfo = { Args = [ arr ] }
+           },
+           _,
+           _) -> Some arr
+    | _ -> None
+
 /// Test the existing DU representation without inspecting payload types.
 let makeUnionTypeTest (cases: UnionCase list) (expr: Beam.ErlExpr) =
     // decision: Match emitted case tags and arities because DU values carry no nominal type or generic argument metadata.

src/Fable.Transforms/Beam/Fable2Beam.fs

@@ -1084,6 +1084,17 @@ let rec transformExpr (com: IBeamCompiler) (ctx: Context) (expr: Expr) : Beam.Er
                 Beam.ErlExpr.Apply(Beam.ErlExpr.Variable loopName, [])
             ]
 
+    | ForLoop(ident, start, limit, body, isUp, range) when
+        not (
+            isStableForLoopLimit limit
+            || isReReadForLoopLimitWith com tryGetArrayOfLength isUp limit
+        )
+        ->
+        let getUniqueName name = $"%s{name}_%d{com.IncrementCounter()}"
+
+        makeForLoopWithBoundLimit getUniqueName range isUp ident start limit body
+        |> transformExpr com ctx
+
     | ForLoop(ident, start, limit, body, isUp, _range) ->
         // Transform for loop to a tail-recursive named fun:
         // For_loop_ = fun For_loop_(I) ->

src/Fable.Transforms/Dart/Fable2Dart.fs

@@ -2253,6 +2253,12 @@ module Util =
                 ],
                 None
 
+        | Fable.ForLoop(var, start, limit, body, isUp, range) when
+            not (isStableForLoopLimit limit || isReReadForLoopLimit com isUp limit)
+            ->
+            makeForLoopWithBoundLimit (getUniqueNameInDeclarationScope ctx) range isUp var start limit body
+            |> transform com ctx returnStrategy
+
         | Fable.ForLoop(var, start, limit, body, isUp, _range) ->
             let statements, startAndLimit =
                 combineStatementsAndExprs

src/Fable.Transforms/FSharp2Fable.Util.fs

@@ -1302,6 +1302,63 @@ module Patterns =
             ValueSome(ident, start, step, stop, body)
         | _ -> ValueNone
 
+    [<return: Struct>]
+    let (|MutableArrayValue|_|) (expr: FSharpExpr) =
+        let isMutableArray (v: FSharpMemberOrFunctionOrValue) =
+            v.IsMutable
+            && v.FullType.HasTypeDefinition
+            && v.FullType.TypeDefinition.IsArrayType
+
+        match expr with
+        | Value v when isMutableArray v -> ValueSome v
+        | Call(None, v, _, _, []) when isMutableArray v -> ValueSome v
+        | _ -> ValueNone
+
+    [<return: Struct>]
+    let (|MutableArrayLengthMinusOne|_|) (expr: FSharpExpr) =
+        let isDeclaredIn entityFullName (memb: FSharpMemberOrFunctionOrValue) =
+            memb.DeclaringEntity
+            |> Option.bind (fun ent -> ent.TryFullName)
+            |> Option.exists ((=) entityFullName)
+
+        match expr with
+        | Call(None, minus, _, _, [ length; Const((:? int as one), _) ]) when
+            minus.CompiledName = "op_Subtraction" && one = 1
+            ->
+            match length with
+            | Call(None, memb, _, _, [ MutableArrayValue arr as arrExpr ]) when
+                memb.CompiledName = "Length"
+                && isDeclaredIn "Microsoft.FSharp.Collections.ArrayModule" memb
+                ->
+                ValueSome(arr, arrExpr, false)
+            | Call(Some(MutableArrayValue arr as arrExpr), memb, _, _, []) when
+                memb.CompiledName = "get_Length" && isDeclaredIn "System.Array" memb
+                ->
+                ValueSome(arr, arrExpr, true)
+            | _ -> ValueNone
+        | _ -> ValueNone
+
+    [<return: Struct>]
+    let (|ForInMutableArray|_|) =
+        function
+        | FastIntegerForLoop(Const _ as start,
+                             (MutableArrayLengthMinusOne(arr, arrExpr, false) as limit),
+                             Lambda(idx,
+                                    Let((elemVar,
+                                         (Call(None, getArray, _, _, [ MutableArrayValue arr'; Value idx' ]) as elemExpr),
+                                         _),
+                                        rest)),
+                             true,
+                             _,
+                             _) when
+            idx.IsCompilerGenerated
+            && getArray.CompiledName = "GetArray"
+            && arr.Equals(arr')
+            && idx.Equals(idx')
+            ->
+            ValueSome(start, limit, arrExpr, idx, elemVar, elemExpr, rest)
+        | _ -> ValueNone
+
     /// This matches the boilerplate generated for TryGetValue/TryParse/DivRem (see #154, or #1744)
     /// where the F# compiler automatically passes a byref arg and returns it as a tuple
     [<return: Struct>]
@@ -2034,6 +2091,27 @@ module Util =
     open TypeHelpers
     open Identifiers
 
+    let rec private isSameValueRead (expected: Fable.Expr) (actual: Fable.Expr) =
+        match expected, actual with
+        | Fable.IdentExpr i1, Fable.IdentExpr i2 -> i1.Name = i2.Name
+        | Fable.Import(i1, _, _), Fable.Import(i2, _, _) -> i1.Selector = i2.Selector && i1.Path = i2.Path
+        | Fable.Call(callee1, info1, _, _), Fable.Call(callee2, info2, _, _) ->
+            List.isEmpty info1.Args
+            && List.isEmpty info2.Args
+            && Option.isNone info1.ThisArg
+            && Option.isNone info2.ThisArg
+            && isSameValueRead callee1 callee2
+        | _ -> false
+
+    let replaceValueRead (value: Fable.Expr) (replacement: Fable.Expr) (expr: Fable.Expr) =
+        expr
+        |> visitFromOutsideIn (fun e ->
+            if isSameValueRead value e then
+                Some replacement
+            else
+                None
+        )
+
     let isUnitArg (ident: Fable.Ident) =
         ident.IsCompilerGenerated && ident.Type = Fable.Unit
     // && (ident.DisplayName.StartsWith("unitVar") || ident.DisplayName.Contains("@"))

src/Fable.Transforms/FSharp2Fable.fs

@@ -1055,15 +1055,34 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs
             let! lambda = transformExpr com ctx [] lambda
             return lambda
 
-        | FSharpExprPatterns.FastIntegerForLoop(start, limit, body, isUp, _, _) ->
+        | ForInMutableArray(start, limit, arrExpr, idxVar, elemVar, elemExpr, rest) ->
+            let r = makeRangeFrom fsExpr
+            let! arr = transformExpr com ctx [] arrExpr
+            let arrIdent = getIdentUniqueName com ctx "arr" |> makeTypedIdent arr.Type
+            let! start = transformExpr com ctx [] start
+            let! limit = transformExpr com ctx [] limit
+            let limit = replaceValueRead arr (Fable.IdentExpr arrIdent) limit
+            let loopCtx, ident = putIdentInScope com ctx idxVar None
+            let! elem = transformExpr com loopCtx [] elemExpr
+            let elem = replaceValueRead arr (Fable.IdentExpr arrIdent) elem
+            let bodyCtx, elemIdent = putIdentInScope com loopCtx elemVar (Some elem)
+            let! rest = transformExpr com bodyCtx [] rest
+            let body = Fable.Let(elemIdent, elem, rest)
+            return Fable.Let(arrIdent, arr, makeForLoop r true ident start limit body)
+
+        | FSharpExprPatterns.FastIntegerForLoop(start, fsLimit, body, isUp, _, _) ->
             let r = makeRangeFrom fsExpr
 
             match body with
             | FSharpExprPatterns.Lambda(PutIdentInScope com ctx (newContext, ident), body) ->
                 let! start = transformExpr com ctx [] start
-                let! limit = transformExpr com ctx [] limit
+                let! limit = transformExpr com ctx [] fsLimit
                 let! body = transformExpr com newContext [] body
-                return makeForLoop r isUp ident start limit body
+
+                match fsLimit with
+                | MutableArrayLengthMinusOne(_, _, false) when isUp ->
+                    return makeForLoopWithBoundLimit (getIdentUniqueName com ctx) r isUp ident start limit body
+                | _ -> return makeForLoop r isUp ident start limit body
             | _ -> return failwithf $"Unexpected loop %O{r}: %A{fsExpr}"
 
         | FSharpExprPatterns.WhileLoop(guardExpr, bodyExpr, _) ->
@@ -1167,7 +1186,11 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs
             let! limit = transformExpr com ctx [] stopExpr
             let ctx, ident = putIdentInScope com ctx var None
             let! body = transformExpr com ctx [] bodyExpr
-            return makeForLoop r (step = 1) ident start limit body
+
+            match stopExpr with
+            | MutableArrayLengthMinusOne _ when step = 1 ->
+                return makeForLoopWithBoundLimit (getIdentUniqueName com ctx) r true ident start limit body
+            | _ -> return makeForLoop r (step = 1) ident start limit body
 
         | FSharpExprPatterns.Let((var, value, _), body) ->
             match value with

src/Fable.Transforms/Transforms.Util.fs

@@ -1103,6 +1103,66 @@ module AST =
     let makeForLoop range isUp ident start limit body =
         ForLoop(ident, start, limit, body, isUp, range)
 
+    let makeForLoopWithBoundLimit (getUniqueName: string -> string) range isUp ident (start: Expr) (limit: Expr) body =
+        let bindLimit start =
+            let limitIdent = getUniqueName "limit" |> makeTypedIdent limit.Type
+            Let(limitIdent, limit, makeForLoop range isUp ident start (IdentExpr limitIdent) body)
+
+        match start with
+        | Value _ -> bindLimit start
+        | IdentExpr i when not i.IsMutable -> bindLimit start
+        | _ ->
+            let startIdent = getUniqueName "start" |> makeTypedIdent start.Type
+            Let(startIdent, start, bindLimit (IdentExpr startIdent))
+
+    let rec isStableForLoopLimit (limit: Expr) =
+        match limit with
+        | Value(NumberConstant _, _) -> true
+        | IdentExpr ident -> not ident.IsMutable
+        | Get(IdentExpr ident, FieldGet info, _, _) when info.Name = "length" ->
+            match ident.Type with
+            | String
+            | Array(_, (MutableArray | ImmutableArray)) -> not ident.IsMutable
+            | _ -> false
+        | Operation(Unary(_, operand), _, _, _) -> isStableForLoopLimit operand
+        | Operation(Binary(_, left, right), _, _, _) -> isStableForLoopLimit left && isStableForLoopLimit right
+        | _ -> false
+
+    let private isMutableArrayValue (com: Compiler) (expr: Expr) =
+        let isArray =
+            function
+            | Array(_, (MutableArray | ImmutableArray)) -> true
+            | _ -> false
+
+        let isGetterCall (callInfo: CallInfo) =
+            Option.isNone callInfo.ThisArg && List.isEmpty callInfo.Args
+
+        match expr with
+        | IdentExpr ident -> ident.IsMutable && isArray ident.Type
+        | Call(IdentExpr ident, callInfo, _, _) when isGetterCall callInfo -> ident.IsMutable && isArray ident.Type
+        | Call(Import({ Kind = MemberImport memberRef }, _, _), callInfo, typ, _) when
+            isGetterCall callInfo && isArray typ
+            ->
+            match com.TryGetMember(memberRef) with
+            | Some memb -> memb.IsValue && memb.IsMutable
+            | None -> false
+        | _ -> false
+
+    // .NET reads an upward `<mutable array>.Length - 1` bound on every iteration
+    let isReReadForLoopLimitWith (com: Compiler) (isLength: Expr -> Expr option) isUp (limit: Expr) =
+        match limit with
+        | Operation(Binary(BinaryMinus, length, Value(NumberConstant(NumberValue.Int32 1, _), _)), _, _, _) when isUp ->
+            match length with
+            | Get(arr, FieldGet info, _, _) when info.Name = "length" -> isMutableArrayValue com arr
+            | length ->
+                match isLength length with
+                | Some arr -> isMutableArrayValue com arr
+                | None -> false
+        | _ -> false
+
+    let isReReadForLoopLimit (com: Compiler) isUp (limit: Expr) =
+        isReReadForLoopLimitWith com (fun _ -> None) isUp limit
+
     let makeBinOp range typ left right op =
         Operation(Binary(op, left, right), Tags.empty, typ, range)
 

tests/Beam/LoopTests.fs

@@ -142,3 +142,82 @@ let ``test for-in loop with negative step range works inside async`` () =
             count <- count + 1
         equal 5 count
     } |> Async.StartImmediate
+
+[<Fact>]
+let ``test for bound over a collection is evaluated once`` () =
+    let xs = ResizeArray [ 1; 2; 3; 4 ]
+    let mutable n = 0
+    for _ in 0 .. xs.Count - 1 do
+        xs.RemoveAt 0
+        n <- n + 1
+    equal 4 n
+    let ys = ResizeArray [ 1; 2; 3; 4 ]
+    let mutable m = 0
+    for _ = ys.Count - 1 downto ys.Count - 2 do
+        ys.RemoveAt 0
+        m <- m + 1
+    equal 2 m
+
+[<Fact>]
+let ``test for bound with side effects is evaluated once`` () =
+    let calls = ref 0
+    let f x =
+        calls.Value <- calls.Value + 1
+        x
+    let mutable n = 0
+    for _ in 0 .. (let x = f 1 in x + f 1) do
+        n <- n + 1
+    equal 3 n
+    equal 2 calls.Value
+    let log = ResizeArray<string>()
+    let tick name value =
+        log.Add name
+        value
+    for _ = tick "start" 0 to tick "limit" 1 do
+        log.Add "body"
+    String.concat "," log |> equal "start,limit,body,body"
+
+[<Fact>]
+let ``test for bound reading the length of a mutable array minus one is evaluated each iteration`` () =
+    let mutable a = [| 1; 2; 3 |]
+    let mutable n = 0
+    for _ = 0 to a.Length - 1 do
+        a <- [| 1; 2; 3; 4; 5; 6 |]
+        n <- n + 1
+    equal 6 n
+
+[<Fact>]
+let ``test for bound reading the length of a mutable array is evaluated once in other shapes`` () =
+    let mutable a = [| 1; 2; 3 |]
+    let mutable n = 0
+    for _ = 0 to Array.length a - 1 do
+        a <- [| 1 |]
+        n <- n + 1
+    equal 3 n
+    a <- [| 1; 2; 3 |]
+    let mutable m = 0
+    for _ in 0 .. 1 .. a.Length - 1 do
+        a <- [| 1 |]
+        m <- m + 1
+    equal 3 m
+    a <- [| 1; 2; 3 |]
+    let mutable p = 0
+    for _ = (a <- [| 1; 2; 3; 4 |]; 0) to Array.length a - 1 do
+        a <- [| 1 |]
+        p <- p + 1
+    equal 4 p
+
+[<Fact>]
+let ``test for in over a mutable array reassigned in the body iterates the array held at loop start`` () =
+    let mutable a = [| 1; 2; 3 |]
+    let mutable sum = 0
+    for x in a do
+        a <- [| 100 |]
+        sum <- sum + x
+    equal 6 sum
+    let mutable pairs = [| (1, 2); (3, 4) |]
+    let mutable total = 0
+    for (x, y) in pairs do
+        pairs <- [| (100, 100) |]
+        total <- total + x + y
+    equal 10 total