Skip to content

Commit

Permalink
Improved pattern compilation (#11993)
Browse files Browse the repository at this point in the history
* update

* fix test case

* column-based type tests

* column-based type tests

* update test

* improved type matching analysis

* improve diagnostics

* fix codegen

* fix baselines

* fix baselines

* update baselines and improve isinst codegen

* missing file

* update baselines

Co-authored-by: Don Syme <donsyme@fastmail.com>
  • Loading branch information
dsyme and Don Syme authored Mar 15, 2022
1 parent b9ed7c1 commit 597446a
Show file tree
Hide file tree
Showing 70 changed files with 10,424 additions and 10,188 deletions.
4 changes: 2 additions & 2 deletions src/fsharp/CompilerImports.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1834,12 +1834,12 @@ and [<Sealed>] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse
let primaryScopeRef =
match primaryAssem with
| _, [ResolvedImportedAssembly ccu] -> ccu.FSharpViewOfMetadata.ILScopeRef
| _ -> failwith "unexpected"
| _ -> failwith "primaryScopeRef - unexpected"

let primaryAssemblyResolvedPath =
match primaryAssemblyResolution with
| [primaryAssemblyResolution] -> primaryAssemblyResolution.resolvedPath
| _ -> failwith "unexpected"
| _ -> failwith "primaryAssemblyResolvedPath - unexpected"

let resolvedAssemblies = tcResolutions.GetAssemblyResolutions()

Expand Down
34 changes: 23 additions & 11 deletions src/fsharp/IlxGen.fs
Original file line number Diff line number Diff line change
Expand Up @@ -3827,6 +3827,7 @@ and eligibleForFilter (cenv: cenv) expr =
| Expr.Op(TOp.Coerce _, _, _, _) -> true
| Expr.Val _ -> true
| _ -> false

and checkDecisionTree dtree =
match dtree with
| TDSwitch(ve, cases, dflt, _) ->
Expand All @@ -3835,6 +3836,7 @@ and eligibleForFilter (cenv: cenv) expr =
dflt |> Option.forall checkDecisionTree
| TDSuccess (es, _) -> es |> List.forall check
| TDBind(bind, rest) -> check bind.Expr && checkDecisionTree rest

and checkDecisionTreeCase dcase =
let (TCase(test, tree)) = dcase
checkDecisionTree tree &&
Expand Down Expand Up @@ -4174,6 +4176,11 @@ and GenAsmCode cenv cgbuf eenv (il, tyargs, args, returnTys, m) sequel =
GenSequel cenv eenv.cloc cgbuf sequel
| _ -> failwith "Bad polymorphic IL instruction"

// ldnull; cgt.un then branch is used to test for null and can become a direct brtrue/brfalse
| [ AI_ldnull; AI_cgt_un ], [arg1], CmpThenBrOrContinue(1, [ I_brcmp (bi, label1) ]), _ ->

GenExpr cenv cgbuf eenv arg1 (CmpThenBrOrContinue(pop 1, [ I_brcmp (bi, label1) ]))

// Strip off any ("ceq" x false) when the sequel is a comparison branch and change the BI_brfalse to a BI_brtrue
// This is the instruction sequence for "not"
// For these we can just generate the argument and change the test (from a brfalse to a brtrue and vice versa)
Expand All @@ -4182,19 +4189,21 @@ and GenAsmCode cenv cgbuf eenv (il, tyargs, args, returnTys, m) sequel =
CmpThenBrOrContinue(1, [I_brcmp (BI_brfalse | BI_brtrue as bi, label1) ]),
_) ->

let bi = match bi with BI_brtrue -> BI_brfalse | _ -> BI_brtrue
GenExpr cenv cgbuf eenv arg1 (CmpThenBrOrContinue(pop 1, [ I_brcmp (bi, label1) ]))
let bi = match bi with BI_brtrue -> BI_brfalse | _ -> BI_brtrue
GenExpr cenv cgbuf eenv arg1 (CmpThenBrOrContinue(pop 1, [ I_brcmp (bi, label1) ]))

// Query; when do we get a 'ret' in IL assembly code?
| [ I_ret ], [arg1], sequel, [_ilRetTy] ->
GenExpr cenv cgbuf eenv arg1 Continue
CG.EmitInstr cgbuf (pop 1) Push0 I_ret
GenSequelEndScopes cgbuf sequel

GenExpr cenv cgbuf eenv arg1 Continue
CG.EmitInstr cgbuf (pop 1) Push0 I_ret
GenSequelEndScopes cgbuf sequel

// Query; when do we get a 'ret' in IL assembly code?
| [ I_ret ], [], sequel, [_ilRetTy] ->
CG.EmitInstr cgbuf (pop 1) Push0 I_ret
GenSequelEndScopes cgbuf sequel

CG.EmitInstr cgbuf (pop 1) Push0 I_ret
GenSequelEndScopes cgbuf sequel

// 'throw' instructions are a bit of a problem - e.g. let x = (throw ...) in ... expects a value *)
// to be left on the stack. But dead-code checking by some versions of the .NET verifier *)
Expand Down Expand Up @@ -5768,8 +5777,8 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau
match firstDiscrim with
// Iterated tests, e.g. exception constructors, nulltests, typetests and active patterns.
// These should always have one positive and one negative branch
| DecisionTreeTest.IsInst _
| DecisionTreeTest.ArrayLength _
| DecisionTreeTest.IsInst _
| DecisionTreeTest.IsNull
| DecisionTreeTest.Const(Const.Zero) ->
if not (isSingleton cases) || Option.isNone defaultTargetOpt then failwith "internal error: GenDecisionTreeSwitch: DecisionTreeTest.IsInst/isnull/query"
Expand All @@ -5793,7 +5802,9 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau
CG.EmitInstr cgbuf (pop 1) Push0 (I_brcmp (bi, (List.head caseLabels).CodeLabel))
GenDecisionTreeCases cenv cgbuf stackAtTargets eenv defaultTargetOpt targets targetCounts targetInfos sequel caseLabels cases contf

| DecisionTreeTest.ActivePatternCase _ -> error(InternalError("internal error in codegen: DecisionTreeTest.ActivePatternCase", switchm))
| DecisionTreeTest.ActivePatternCase _ ->
error(InternalError("internal error in codegen: DecisionTreeTest.ActivePatternCase", switchm))

| DecisionTreeTest.UnionCase (hdc, tyargs) ->
GenExpr cenv cgbuf eenv e Continue
let cuspec = GenUnionSpec cenv.amap m eenv.tyenv hdc.TyconRef tyargs
Expand Down Expand Up @@ -5853,7 +5864,8 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau
GenDecisionTreeCases cenv cgbuf stackAtTargets eenv defaultTargetOpt targets targetCounts targetInfos sequel caseLabels cases contf
| _ -> error(InternalError("these matches should never be needed", switchm))

| DecisionTreeTest.Error m -> error(InternalError("Trying to compile error recovery branch", m))
| DecisionTreeTest.Error m ->
error(InternalError("Trying to compile error recovery branch", m))

and GenDecisionTreeCases cenv cgbuf stackAtTargets eenv defaultTargetOpt targets targetCounts targetInfos sequel caseLabels cases (contf: Zmap<_,_> -> FakeUnit) =

Expand Down Expand Up @@ -7429,7 +7441,7 @@ and GenModuleDef cenv (cgbuf: CodeGenBuffer) qname lazyInitInfo eenv x =
let recBinds =
bindsRemaining
|> List.takeWhile (function ModuleOrNamespaceBinding.Binding _ -> true | _ -> false)
|> List.map (function ModuleOrNamespaceBinding.Binding recBind -> recBind | _ -> failwith "unexpected")
|> List.map (function ModuleOrNamespaceBinding.Binding recBind -> recBind | _ -> failwith "GenModuleDef - unexpected")
let otherBinds =
bindsRemaining
|> List.skipWhile (function ModuleOrNamespaceBinding.Binding _ -> true | _ -> false)
Expand Down
14 changes: 13 additions & 1 deletion src/fsharp/Optimizer.fs
Original file line number Diff line number Diff line change
Expand Up @@ -3807,6 +3807,17 @@ and TryOptimizeDecisionTreeTest cenv test vinfo =

/// Optimize/analyze a switch construct from pattern matching
and OptimizeSwitch cenv env (e, cases, dflt, m) =
let g = cenv.g

// Replace IsInst tests by calls to the helper for type tests, which may then get optimized
let e, cases =
match cases with
| [ TCase(DecisionTreeTest.IsInst (_srcTy, tgTy), success)] ->
let testExpr = mkCallTypeTest g m tgTy e
let testCases = [TCase(DecisionTreeTest.Const(Const.Bool true), success)]
testExpr, testCases
| _ -> e, cases

let eR, einfo = OptimizeExpr cenv env e

let cases, dflt =
Expand All @@ -3820,7 +3831,8 @@ and OptimizeSwitch cenv env (e, cases, dflt, m) =
dflt
else
cases, dflt
// OK, see what weRre left with and continue

// OK, see what we are left with and continue
match cases, dflt with
| [], Some case -> OptimizeDecisionTree cenv env m case
| _ -> OptimizeSwitchFallback cenv env (eR, einfo, cases, dflt, m)
Expand Down
Loading

0 comments on commit 597446a

Please sign in to comment.