Clean up code for beta binding reduction

Author: alfonsogarciacaro

src/Fable.Cli/Parser.fs

@@ -53,6 +53,7 @@ let private parseDic (key: string) (o: JObject): IDictionary<string,string> =
 let toCompilerOptions (msg: Message): CompilerOptions =
     { typedArrays = msg.typedArrays
       clampByteArrays = msg.clampByteArrays
+      debugMode = Array.contains "DEBUG" msg.define
       verbosity = GlobalParams.Singleton.Verbosity
       outputPublicInlinedFunctions = Array.contains "FABLE_REPL_LIB" msg.define
       precompiledLib = None

src/Fable.Transforms/AST/AST.Fable.fs

@@ -108,7 +108,6 @@ type File(sourcePath, decls, ?usedVarNames, ?inlineDependencies) =
 type IdentKind =
     | UserDeclared
     | CompilerGenerated
-    | InlinedArg
     | BaseValueIdent
     | ThisArgIdentDeclaration
 
@@ -120,8 +119,6 @@ type Ident =
       Range: SourceLocation option }
       member x.IsCompilerGenerated =
         match x.Kind with CompilerGenerated -> true | _ -> false
-      member x.IsInlinedArg =
-        match x.Kind with InlinedArg -> true | _ -> false
       member x.IsBaseValue =
         match x.Kind with BaseValueIdent -> true | _ -> false
       member x.IsThisArgDeclaration =

src/Fable.Transforms/FSharp2Fable.Util.fs

@@ -1079,10 +1079,11 @@ module Util =
             let inExpr = com.GetInlineExpr(memb)
             let ctx, bindings =
                 ((ctx, []), foldArgs [] (inExpr.Args, args)) ||> List.fold (fun (ctx, bindings) (argId, arg) ->
-                    // Change type and mark ident as compiler-generated so it can be optimized
+                    // Change type and mark ident as compiler-generated so Fable also
+                    // tries to inline it in DEBUG mode (some patterns depend on this)
                     let ident = { makeIdentFrom com ctx argId with
                                     Type = arg.Type
-                                    Kind = Fable.InlinedArg }
+                                    Kind = Fable.CompilerGenerated }
                     let ctx = putIdentInScope ctx argId ident (Some arg)
                     ctx, (ident, arg)::bindings)
             let ctx = { ctx with GenericArgs = genArgs.Value |> Map

src/Fable.Transforms/Fable2Babel.fs

@@ -21,7 +21,6 @@ type Import =
 type ITailCallOpportunity =
     abstract Label: string
     abstract Args: string list
-    abstract ReplaceArgs: bool
     abstract IsRecursiveRef: Fable.Expr -> bool
 
 type Context =
@@ -57,27 +56,14 @@ module Util =
         | args -> args
 
     type NamedTailCallOpportunity(com: ICompiler, name, args: Fable.Ident list) =
-        let getTailCallArgIds (com: ICompiler) (args: Fable.Ident list) =
-            // If some arguments are functions we need to capture the current values to
-            // prevent delayed references from getting corrupted, for that we use block-scoped
-            // ES2015 variable declarations. See #681
-            let replaceArgs =
-                args |> List.exists (fun arg ->
-                    match arg.Type with
-                    | Fable.FunctionType _ -> true
-                    | _ -> false)
-            replaceArgs, args |> List.map (fun arg ->
-                if replaceArgs
-                then com.GetUniqueVar("arg")
-                else arg.Name)
-        let replaceArgs, argIds =
-            discardUnitArg args |> getTailCallArgIds com
+        // Capture the current argument values to prevent delayed references from getting corrupted,
+        // for that we use block-scoped ES2015 variable declarations. See #681, #1859
+        let argIds = discardUnitArg args |> List.map (fun arg -> com.GetUniqueVar(arg.Name))
         interface ITailCallOpportunity with
             member __.Label = name
             member __.Args = argIds
-            member __.ReplaceArgs = replaceArgs
             member __.IsRecursiveRef(e) =
-                match e with Fable.IdentExpr id  -> name = id.Name | _ -> false
+                match e with Fable.IdentExpr id -> name = id.Name | _ -> false
 
     let prepareBoundThis (boundThis: string) (args: Fable.Ident list) =
         match args with
@@ -963,19 +949,24 @@ module Util =
         elif List.sameLength idents values then List.zip idents values
         else failwith "Target idents/values lengths differ"
 
-    let getDecisionTargetAndBindValues (ctx: Context) targetIndex boundValues =
+    let getDecisionTargetAndBindValues (com: IBabelCompiler) (ctx: Context) targetIndex boundValues =
         let idents, target = getDecisionTarget ctx targetIndex
-        let bindings, replacements =
-            (([], Map.empty), matchTargetIdentAndValues idents boundValues)
-            ||> List.fold (fun (bindings, replacements) (ident, expr) ->
-                if hasDoubleEvalRisk expr <> DoubleEvalRisk.No // && isReferencedMoreThan 1 ident.Name body
-                then (ident, expr)::bindings, replacements
-                else bindings, Map.add ident.Name expr replacements)
-        let target = FableTransforms.replaceValues replacements target
-        bindings, target
+        let identsAndValues = matchTargetIdentAndValues idents boundValues
+        if not com.Options.debugMode then
+            let bindings, replacements =
+                (([], Map.empty), identsAndValues)
+                ||> List.fold (fun (bindings, replacements) (ident, expr) ->
+                    if canHaveSideEffects expr then
+                        (ident, expr)::bindings, replacements
+                    else
+                        bindings, Map.add ident.Name expr replacements)
+            let target = FableTransforms.replaceValues replacements target
+            List.rev bindings, target
+        else
+            identsAndValues, target
 
     let transformDecisionTreeSuccessAsExpr (com: IBabelCompiler) (ctx: Context) targetIndex boundValues =
-        let bindings, target = getDecisionTargetAndBindValues ctx targetIndex boundValues
+        let bindings, target = getDecisionTargetAndBindValues com ctx targetIndex boundValues
         match bindings with
         | [] -> com.TransformAsExpr(ctx, target)
         | bindings -> com.TransformAsExpr(ctx, Fable.Let(bindings, target))
@@ -991,8 +982,8 @@ module Util =
             let targetAssignment = assign None targetId (ofInt targetIndex) |> ExpressionStatement :> Statement
             Array.append [|targetAssignment|] assignments
         | ret ->
-            let bindings, target = getDecisionTargetAndBindValues ctx targetIndex boundValues
-            let bindings = bindings |> List.rev |> Seq.collect (fun (i, v) -> transformBindingAsStatements com ctx i v) |> Seq.toArray
+            let bindings, target = getDecisionTargetAndBindValues com ctx targetIndex boundValues
+            let bindings = bindings |> Seq.collect (fun (i, v) -> transformBindingAsStatements com ctx i v) |> Seq.toArray
             Array.append bindings (com.TransformAsStatements(ctx, ret, target))
 
     let transformDecisionTreeAsSwitch expr =
@@ -1101,8 +1092,19 @@ module Util =
                         (targets: (Fable.Ident list * Fable.Expr) list) (treeExpr: Fable.Expr): Statement[] =
         // If some targets are referenced multiple times, host bound idents,
         // resolve the decision index and compile the targets as a switch
-        let targetsWithMultiRefs = getTargetsWithMultipleReferences treeExpr
-        if not(List.isEmpty targetsWithMultiRefs) then
+        match getTargetsWithMultipleReferences treeExpr with
+        | [] ->
+            let ctx = { ctx with DecisionTargets = targets }
+            match transformDecisionTreeAsSwitch treeExpr with
+            | Some(evalExpr, cases, (defaultIndex, defaultBoundValues)) ->
+                let t = treeExpr.Type
+                let cases = cases |> List.map (fun (caseExpr, targetIndex, boundValues) ->
+                    [caseExpr], Fable.DecisionTreeSuccess(targetIndex, boundValues, t))
+                let defaultCase = Fable.DecisionTreeSuccess(defaultIndex, defaultBoundValues, t)
+                [|transformSwitch com ctx true returnStrategy evalExpr cases (Some defaultCase)|]
+            | None ->
+                com.TransformAsStatements(ctx, returnStrategy, treeExpr)
+        | targetsWithMultiRefs ->
             // If the bound idents are not referenced in the target, remove them
             let targets =
                 targets |> List.map (fun (idents, expr) ->
@@ -1126,17 +1128,6 @@ module Util =
                     transformDecisionTreeWithTwoSwitches com ctx returnStrategy targets treeExpr
             else
                 transformDecisionTreeWithTwoSwitches com ctx returnStrategy targets treeExpr
-        else
-            let ctx = { ctx with DecisionTargets = targets }
-            match transformDecisionTreeAsSwitch treeExpr with
-            | Some(evalExpr, cases, (defaultIndex, defaultBoundValues)) ->
-                let t = treeExpr.Type
-                let cases = cases |> List.map (fun (caseExpr, targetIndex, boundValues) ->
-                    [caseExpr], Fable.DecisionTreeSuccess(targetIndex, boundValues, t))
-                let defaultCase = Fable.DecisionTreeSuccess(defaultIndex, defaultBoundValues, t)
-                [|transformSwitch com ctx true returnStrategy evalExpr cases (Some defaultCase)|]
-            | None ->
-                com.TransformAsStatements(ctx, returnStrategy, treeExpr)
 
     let rec transformAsExpr (com: IBabelCompiler) ctx (expr: Fable.Expr): Expression =
         match expr with
@@ -1317,14 +1308,13 @@ module Util =
         let args, body =
             match isTailCallOptimized, tailcallChance, body with
             | true, Some tc, U2.Case1 body ->
+                // Replace args, see NamedTailCallOpportunity constructor
                 let args, body =
-                    if tc.ReplaceArgs then
-                        let varDeclaration =
-                            List.zip args tc.Args |> List.map (fun (arg, tempVar) ->
-                                arg.Name, Some(Identifier tempVar :> Expression))
-                            |> multiVarDeclaration Const
-                        tc.Args |> List.map Identifier, BlockStatement(Array.append [|varDeclaration|] body.Body)
-                    else args, body
+                    let varDeclaration =
+                        List.zip args tc.Args |> List.map (fun (arg, tempVar) ->
+                            arg.Name, Some(Identifier tempVar :> Expression))
+                        |> multiVarDeclaration Const
+                    tc.Args |> List.map Identifier, BlockStatement(Array.append [|varDeclaration|] body.Body)
                 // Make sure we don't get trapped in an infinite loop, see #1624
                 let body = BlockStatement(Array.append body.Body [|BreakStatement()|])
                 args, LabeledStatement(Identifier tc.Label, WhileStatement(BooleanLiteral true, body))

src/Fable.Transforms/FableTransforms.fs

@@ -207,61 +207,23 @@ let countReferences limit identName body =
         | _ -> false) |> ignore
     count
 
-/// Values with risk of double evaluation must be captured. If it appears in the body
-/// of a function it can leak, so consider as it had exceeded the references limit.
-let countReferencesPreventingLeak limit identName body =
-    let rec traverse f (insideFunction: bool) (exprs: Expr list) =
-        (false, exprs) ||> List.fold (fun stop expr ->
-            stop ||
-                let stop, insideFunction', exprs = f insideFunction expr
-                stop ||
-                    match exprs with
-                    | [] -> false
-                    | exprs -> traverse f (insideFunction || insideFunction') exprs)
-    let mutable count = 0
-    (false, [body]) ||> traverse (fun insideFunction expr ->
-        match expr with
-        | IdentExpr id2 when id2.Name = identName ->
-            count <-
-                if limit > 0 then
-                    (if insideFunction then limit else count) + 1
-                elif insideFunction then 1
-                else 0
-            count > limit, false, []
-        // If the function is immediately applied we don't have to worry about leaks
-        // | NestedApply(NestedLambda(args, body, _), argExprs, _, _) when List.sameLength args argExprs ->
-        //     false, false, argExprs @ [body]
-        | Function(_,body,_) ->
-            false, true, [body]
-        | e ->
-            false, false, getSubExpressions e) |> ignore
-    count
-
-let preventLeak identName body =
-    countReferencesPreventingLeak -1 identName body = 0
-
 let canInlineArg identName value body =
     match value with
     | Function _ -> countReferences 1 identName body <= 1
-    | value ->
-        match hasDoubleEvalRisk value with
-        | DoubleEvalRisk.No -> true
-        // Don't erase expressions referenced 0 times, they may have side-effects
-        | DoubleEvalRisk.Yes -> countReferencesPreventingLeak 1 identName body = 1
-        | DoubleEvalRisk.InTailCalls identName -> preventLeak identName body
+    | value -> canHaveSideEffects value |> not
 
 module private Transforms =
     let (|LambdaOrDelegate|_|) = function
         | Function(Lambda arg, body, name) -> Some([arg], body, name)
         | Function(Delegate args, body, name) -> Some(args, body, name)
         | _ -> None
 
-    let lambdaBetaReduction (_: ICompiler) e =
+    let lambdaBetaReduction (com: ICompiler) e =
         let applyArgs (args: Ident list) argExprs body =
             let bindings, replacements =
                 (([], Map.empty), args, argExprs)
                 |||> List.fold2 (fun (bindings, replacements) ident expr ->
-                    if canInlineArg ident.Name expr body
+                    if not com.Options.debugMode && canInlineArg ident.Name expr body
                     then bindings, Map.add ident.Name expr replacements
                     else (ident, expr)::bindings, replacements)
             match bindings with
@@ -271,22 +233,9 @@ module private Transforms =
         // TODO: Other binary operations and numeric types, also recursive?
         | Operation(BinaryOperation(AST.BinaryPlus, Value(StringConstant str1, r1), Value(StringConstant str2, r2)),_,_) ->
             Value(StringConstant(str1 + str2), addRanges [r1; r2])
-        // The F# compiler converts non-curried module and class members to curried lambdas when necessary
-        // but we can remove all the wrapping if the result is immediately applied
-        // We assume the compiler generated bindings/args can be inlined
-        | NestedApply(NestedCompilerGeneratedLetsAndLambdas(identValues, lambdaArgs, body), appliedArgs,_,_)
-                when List.sameLength lambdaArgs appliedArgs ->
-            let replacements =
-                List.zip lambdaArgs appliedArgs
-                |> List.map (fun (i,v) -> i.Name,v) |> Map
-            let replacements =
-                (replacements, identValues)
-               ||> List.fold (fun replacements (i,v) ->
-                    Map.add i.Name (replaceValues replacements v) replacements)
-            replaceValues replacements body
-        | Operation(CurriedApply(NestedLambda(args, body, None) as lambda, argExprs), _, _) ->
-            if List.sameLength args argExprs
-            then applyArgs args argExprs body
+        | NestedApply(NestedLambdaRelaxed(lambdaArgs, body, _) as lambda, argExprs,_,_) ->
+            if List.sameLength lambdaArgs argExprs then
+                applyArgs lambdaArgs argExprs body
             else
                 // Partial apply
                 match List.length argExprs, lambda with
@@ -308,17 +257,29 @@ module private Transforms =
         | e -> e
 
     let bindingBetaReduction (com: ICompiler) e =
+        // Don't erase user-declared bindings in debug mode for better source maps
+        let isErasingCandidate (ident: Ident) =
+            (not com.Options.debugMode) || ident.IsCompilerGenerated
         match e with
         // Don't try to optimize bindings with multiple ident-value pairs as they can reference each other
-        | Let([ident, value], letBody) when not ident.IsMutable
-                                            && (ident.IsInlinedArg || ident.IsCompilerGenerated)
-                                            && canInlineArg ident.Name value letBody ->
-            let value =
+        | Let([ident, value], letBody) when not ident.IsMutable && isErasingCandidate ident ->
+            let canEraseBinding =
                 match value with
-                // Ident name becomes the name of the function (mainly used for tail call optimizations)
-                | Function(args, funBody, _) -> Function(args, funBody, Some ident.Name)
-                | value -> value
-            replaceValues (Map [ident.Name, value]) letBody                
+                | NestedLambdaRelaxed(_, lambdaBody, _) ->
+                    match lambdaBody with
+                    | Import _ -> false
+                           // Check the lambda doesn't reference itself recursively
+                    | _ -> countReferences 0 ident.Name lambdaBody = 0
+                           && canInlineArg ident.Name value letBody
+                | _ -> canInlineArg ident.Name value letBody
+            if canEraseBinding then
+                let value =
+                    match value with
+                    // Ident becomes the name of the function (mainly used for tail call optimizations)
+                    | Function(args, funBody, _) -> Function(args, funBody, Some ident.Name)
+                    | value -> value
+                replaceValues (Map [ident.Name, value]) letBody
+            else e            
         | e -> e
 
     /// Returns arity of lambda (or lambda option) types

src/Fable.Transforms/Global/Compiler.fs

@@ -9,6 +9,7 @@ type Verbosity =
 type CompilerOptions =
     { typedArrays: bool
       clampByteArrays: bool
+      debugMode: bool
       verbosity: Verbosity
       /// Meant for precompiled libraries (like the Repl Lib)
       /// to make public inlined functions part of the JS