Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix 635: combine boolean logic #5116

Merged
merged 11 commits into from
Sep 15, 2018
83 changes: 82 additions & 1 deletion src/fsharp/Optimizer.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1382,6 +1382,85 @@ let rec (|KnownValApp|_|) expr =
| Expr.App(KnownValApp(vref, typeArgs1, otherArgs1), _, typeArgs2, otherArgs2, _) -> Some(vref, typeArgs1@typeArgs2, otherArgs1@otherArgs2)
| _ -> None

// Matches boolean decision tree:
// check single case with bool const.
let (|TDBoolSwitch|_|) dtree =
match dtree with
| TDSwitch( expr,
[TCase (DecisionTreeTest.Const(Const.Bool b), caseTree )],
Some defaultTree,
range) -> Some (expr, b, caseTree, defaultTree, range)
| _ -> None

// check target that have a constant bool value
let (|ConstantBoolTarget|_|) t =
match t with
| TTarget([], Expr.Const (Const.Bool b,_,_),_) -> Some b
| _ -> None

/// Is this a tree, where each decision is a two-way switch (to prevent later duplication of trees), and each branch returns or true/false,
/// apart from one branch which defers to another expression
let rec CountBoolLogicTree ((targets: DecisionTreeTarget[], costOuterCaseTree, costOuterDefaultTree, testBool) as data) tree =
match tree with
| TDSwitch (_expr, [case], Some defaultTree, _range) ->
let tc1,ec1 = CountBoolLogicTree data case.CaseTree
let tc2, ec2 = CountBoolLogicTree data defaultTree
tc1 + tc2, ec1 + ec2
| TDSuccess([], idx) ->
match targets.[idx] with
| ConstantBoolTarget result -> (if result = testBool then costOuterCaseTree else costOuterDefaultTree), 0
| TTarget([], _exp, _) -> costOuterCaseTree + costOuterDefaultTree, 10
| _ -> 100, 100
| _ -> 100, 100

/// Rewrite a decision tree for which IsBoolLogic returned true. Produce aa new decision
/// tree where at each ConstantBoolSuccessTree tip we replace with either outerCaseTree or outerDefaultTree
/// depending on whether the target result was true/false
let rec RewriteBoolLogicTree ((targets: DecisionTreeTarget[], outerCaseTree, outerDefaultTree, testBool) as data) tree =
match tree with
| TDSwitch (expr, cases, defaultTree, range) ->
let cases2 = cases |> List.map (RewriteBoolLogicCase data)
let defaultTree2 = defaultTree |> Option.map (RewriteBoolLogicTree data)
TDSwitch (expr, cases2, defaultTree2, range)
| TDSuccess([], idx) ->
match targets.[idx] with
| ConstantBoolTarget result -> if result = testBool then outerCaseTree else outerDefaultTree
| TTarget([], exp, _) -> mkBoolSwitch exp.Range exp outerCaseTree outerDefaultTree
| _ -> failwith "CountBoolLogicTree should exclude this case"
| _ -> failwith "CountBoolLogicTree should exclude this case"

and RewriteBoolLogicCase data (TCase(test, tree)) =
TCase(test, RewriteBoolLogicTree data tree)

// Repeatedly combine switch-over-match decision trees, see https://github.com/Microsoft/visualfsharp/issues/635.
// The outer decision tree is doing a swithc over a boolean result, the inner match is producing only
// constant boolean results in its targets.
let rec CombineBoolLogic expr =

// try to find nested boolean switch
match expr with
| Expr.Match(outerSP, outerMatchRange,
TDBoolSwitch(Expr.Match(_innerSP, _innerMatchRange, innerTree, innerTargets, _innerDefaultRange, _innerMatchTy),
outerTestBool, outerCaseTree, outerDefaultTree, _outerSwitchRange ),
outerTargets, outerDefaultRange, outerMatchTy) ->

let costOuterCaseTree = match outerCaseTree with TDSuccess _ -> 0 | _ -> 1
let costOuterDefaultTree = match outerDefaultTree with TDSuccess _ -> 0 | _ -> 1
let tc, ec = CountBoolLogicTree (innerTargets, costOuterCaseTree, costOuterDefaultTree, outerTestBool) innerTree
// At most one expression, no overall duplication of TSwitch nodes
if tc <= costOuterCaseTree + costOuterDefaultTree && ec <= 10 then
let newExpr =
Expr.Match(outerSP, outerMatchRange,
RewriteBoolLogicTree (innerTargets, outerCaseTree, outerDefaultTree, outerTestBool) innerTree,
outerTargets, outerDefaultRange, outerMatchTy)

CombineBoolLogic newExpr
else
expr
| _ ->
expr


//-------------------------------------------------------------------------
// ExpandStructuralBinding
//
Expand Down Expand Up @@ -2811,7 +2890,9 @@ and OptimizeMatch cenv env (spMatch, exprm, dtree, targets, m, ty) =
// REVIEW: consider collecting, merging and using information flowing through each line of the decision tree to each target
let dtree', dinfo = OptimizeDecisionTree cenv env m dtree
let targets', tinfos = OptimizeDecisionTreeTargets cenv env m targets
RebuildOptimizedMatch (spMatch, exprm, m, ty, dtree', targets', dinfo, tinfos)
let newExpr, newInfo = RebuildOptimizedMatch (spMatch, exprm, m, ty, dtree', targets', dinfo, tinfos)
let newExpr2 = if not (cenv.settings.localOpt()) then newExpr else CombineBoolLogic newExpr
newExpr2, newInfo

and CombineMatchInfos dinfo tinfo =
{ TotalSize = dinfo.TotalSize + tinfo.TotalSize
Expand Down
84 changes: 44 additions & 40 deletions src/fsharp/tast.fs
Original file line number Diff line number Diff line change
Expand Up @@ -261,7 +261,7 @@ type ValFlags(flags:int64) =
(flags &&& ~~~0b0011001100000000000L)

/// Represents the kind of a type parameter
[<RequireQualifiedAccess; StructuredFormatDisplay("{DebugText}")>]
[<RequireQualifiedAccess (* ; StructuredFormatDisplay("{DebugText}") *) >]
type TyparKind =

| Type
Expand All @@ -273,13 +273,10 @@ type TyparKind =
| TyparKind.Type -> None
| TyparKind.Measure -> Some "Measure"

[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
member x.DebugText = x.ToString()
//[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
//member x.DebugText = x.ToString()

override x.ToString() =
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is the change that seems to break tests.
the casing of 'type' has changed.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Thanks for spotting this.

match x with
| TyparKind.Type -> "type"
| TyparKind.Measure -> "measure"
override x.ToString() = sprintf "%+A" x

[<RequireQualifiedAccess>]
/// Indicates if the type variable can be solved or given new constraints. The status of a type variable
Expand Down Expand Up @@ -1338,7 +1335,7 @@ and
override x.ToString() = "TyconAugmentation(...)"

and
[<NoEquality; NoComparison; StructuredFormatDisplay("{DebugText}")>]
[<NoEquality; NoComparison (*; StructuredFormatDisplay("{DebugText}") *) >]
/// The information for the contents of a type. Also used for a provided namespace.
TyconRepresentation =

Expand Down Expand Up @@ -1382,10 +1379,10 @@ and
/// The information for exception definitions should be folded into here.
| TNoRepr

[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
member x.DebugText = x.ToString()
//[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
//member x.DebugText = x.ToString()

override x.ToString() = "TyconRepresentation(...)"
override x.ToString() = sprintf "%+A" x

and
[<NoEquality; NoComparison; StructuredFormatDisplay("{DebugText}")>]
Expand Down Expand Up @@ -1740,7 +1737,7 @@ and
override x.ToString() = x.Name

and
[<NoEquality; NoComparison; StructuredFormatDisplay("{DebugText}")>]
[<NoEquality; NoComparison (*; StructuredFormatDisplay("{DebugText}") *) >]
ExceptionInfo =
/// Indicates that an exception is an abbreviation for the given exception
| TExnAbbrevRepr of TyconRef
Expand All @@ -1754,10 +1751,11 @@ and
/// Indicates that an exception is abstract, i.e. is in a signature file, and we do not know the representation
| TExnNone

[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
member x.DebugText = x.ToString()
// %+A formatting is used, so this is not needed
//[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
//member x.DebugText = x.ToString()

override x.ToString() = "ExceptionInfo(...)"
override x.ToString() = sprintf "%+A" x

and [<Sealed; StructuredFormatDisplay("{DebugText}")>]
ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList<Val>, entities: QueueList<Entity>) =
Expand Down Expand Up @@ -2323,11 +2321,11 @@ and
/// Indicates a constraint that a type is .NET unmanaged type
| IsUnmanaged of range

// Prefer the default formatting of this union type
// %+A formatting is used, so this is not needed
//[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
//member x.DebugText = x.ToString()
//
//override x.ToString() = "TyparConstraint(...)"

override x.ToString() = sprintf "%+A" x

/// The specification of a member constraint that must be solved
and
Expand Down Expand Up @@ -2357,7 +2355,7 @@ and
override x.ToString() = "TTrait(" + x.MemberName + ")"

and
[<NoEquality; NoComparison; StructuredFormatDisplay("{DebugText}")>]
[<NoEquality; NoComparison (* ; StructuredFormatDisplay("{DebugText}") *) >]
/// Indicates the solution of a member constraint during inference.
TraitConstraintSln =

Expand Down Expand Up @@ -2394,10 +2392,11 @@ and
/// Indicates a trait is solved by a 'fake' instance of an operator, like '+' on integers
| BuiltInSln

[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
member x.DebugText = x.ToString()
// %+A formatting is used, so this is not needed
//[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
//member x.DebugText = x.ToString()

override x.ToString() = "TraitConstraintSln(...)"
override x.ToString() = sprintf "%+A" x

/// The partial information used to index the methods of all those in a ModuleOrNamespace.
and [<RequireQualifiedAccess; StructuredFormatDisplay("{DebugText}")>]
Expand Down Expand Up @@ -3979,11 +3978,11 @@ and
/// Raising a measure to a rational power
| RationalPower of Measure * Rational

// Prefer the default formatting of this union type
// %+A formatting is used, so this is not needed
//[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
//member x.DebugText = x.ToString()
//
//override x.ToString() = "Measure(...)"

override x.ToString() = sprintf "%+A" x

and
[<NoEquality; NoComparison; RequireQualifiedAccess; StructuredFormatDisplay("{DebugText}")>]
Expand Down Expand Up @@ -4232,7 +4231,7 @@ and
and Attribs = Attrib list

and
[<NoEquality; NoComparison; StructuredFormatDisplay("{DebugText}")>]
[<NoEquality; NoComparison (* ; StructuredFormatDisplay("{DebugText}") *) >]
AttribKind =

/// Indicates an attribute refers to a type defined in an imported .NET assembly
Expand All @@ -4241,10 +4240,11 @@ and
/// Indicates an attribute refers to a type defined in an imported F# assembly
| FSAttrib of ValRef

[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
member x.DebugText = x.ToString()
// %+A formatting is used, so this is not needed
//[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
//member x.DebugText = x.ToString()

override x.ToString() = sprintf "AttribKind(...)"
override x.ToString() = sprintf "%+A" x

/// Attrib(kind,unnamedArgs,propVal,appliedToAGetterOrSetter,targetsOpt,range)
and
Expand Down Expand Up @@ -4308,10 +4308,11 @@ and [<RequireQualifiedAccess>]

/// Decision trees. Pattern matching has been compiled down to
/// a decision tree by this point. The right-hand-sides (actions) of
/// a decision tree by this point. The right-hand-sides (actions) of
/// the decision tree are labelled by integers that are unique for that
/// particular tree.
and
[<NoEquality; NoComparison; StructuredFormatDisplay("{DebugText}")>]
[<NoEquality; NoComparison (* ; StructuredFormatDisplay("{DebugText}") *) >]
DecisionTree =

/// TDSwitch(input, cases, default, range)
Expand Down Expand Up @@ -4340,10 +4341,11 @@ and
/// body -- the rest of the decision tree
| TDBind of Binding * DecisionTree

[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
member x.DebugText = x.ToString()
// %+A formatting is used, so this is not needed
//[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
//member x.DebugText = x.ToString()

override x.ToString() = sprintf "DecisionTree(...)"
override x.ToString() = sprintf "%+A" x

/// Represents a test and a subsequent decision tree
and
Expand All @@ -4363,7 +4365,7 @@ and
override x.ToString() = sprintf "DecisionTreeCase(...)"

and
[<NoEquality; NoComparison; RequireQualifiedAccess; StructuredFormatDisplay("{DebugText}")>]
[<NoEquality; NoComparison; RequireQualifiedAccess (*; StructuredFormatDisplay("{DebugText}") *) >]
DecisionTreeTest =
/// Test if the input to a decision tree matches the given union case
| UnionCase of UnionCaseRef * TypeInst
Expand Down Expand Up @@ -4393,10 +4395,11 @@ and
/// activePatternInfo -- The extracted info for the active pattern.
| ActivePatternCase of Expr * TTypes * (ValRef * TypeInst) option * int * ActivePatternInfo

[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
member x.DebugText = x.ToString()
// %+A formatting is used, so this is not needed
//[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
//member x.DebugText = x.ToString()

override x.ToString() = sprintf "DecisionTreeTest(...)"
override x.ToString() = sprintf "%+A" x

/// A target of a decision tree. Can be thought of as a little function, though is compiled as a local block.
and
Expand Down Expand Up @@ -4890,7 +4893,7 @@ and

/// The contents of a module-or-namespace-fragment definition
and
[<NoEquality; NoComparison; StructuredFormatDisplay("{DebugText}")>]
[<NoEquality; NoComparison (* ; StructuredFormatDisplay("{DebugText}") *) >]
ModuleOrNamespaceExpr =
/// Indicates the module is a module with a signature
| TMAbstract of ModuleOrNamespaceExprWithSig
Expand All @@ -4907,10 +4910,11 @@ and
/// Indicates the module fragment is a 'rec' or 'non-rec' definition of types and modules
| TMDefRec of isRec:bool * Tycon list * ModuleOrNamespaceBinding list * range

[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
// %+A formatting is used, so this is not needed
//[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
member x.DebugText = x.ToString()

override x.ToString() = "ModuleOrNamespaceExpr(...)"
override x.ToString() = sprintf "%+A" x

/// A named module-or-namespace-fragment definition
and
Expand Down