Skip to content

Commit

Permalink
Clean up code for beta binding reduction
Browse files Browse the repository at this point in the history
  • Loading branch information
@alfonsogarciacaro
alfonsogarciacaro committed Sep 4, 2019
1 parent 146540a commit e549bb1
Show file tree
Hide file tree
Showing 12 changed files with 125 additions and 171 deletions.
1 change: 1 addition & 0 deletions src/Fable.Cli/Parser.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
3 changes: 0 additions & 3 deletions src/Fable.Transforms/AST/AST.Fable.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -108,7 +108,6 @@ type File(sourcePath, decls, ?usedVarNames, ?inlineDependencies) =
type IdentKind =
| UserDeclared
| CompilerGenerated
| InlinedArg
| BaseValueIdent
| ThisArgIdentDeclaration

Expand All @@ -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 =
Expand Down
5 changes: 3 additions & 2 deletions src/Fable.Transforms/FSharp2Fable.Util.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
90 changes: 40 additions & 50 deletions src/Fable.Transforms/Fable2Babel.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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))
Expand All @@ -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 =
Expand Down Expand Up @@ -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) ->
Expand All @@ -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
Expand Down Expand Up @@ -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))
Expand Down
91 changes: 26 additions & 65 deletions src/Fable.Transforms/FableTransforms.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down
1 change: 1 addition & 0 deletions src/Fable.Transforms/Global/Compiler.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading

0 comments on commit e549bb1

Please sign in to comment.