Skip to content

Commit

Permalink
More ValueOption in compiler: part 2 (#16567)
Browse files Browse the repository at this point in the history
* More ValueOption in complier: part 2

* Update release notes

* extra optimization

* extra optimization 2

* fantomas
  • Loading branch information
psfinaki authored Jan 24, 2024
1 parent 641d0ee commit 1b50168
Show file tree
Hide file tree
Showing 14 changed files with 227 additions and 149 deletions.
2 changes: 1 addition & 1 deletion docs/release-notes/.FSharp.Compiler.Service/8.0.300.md
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,6 @@
* Autogenerated .Is* members for unions skipped for single-case unions. ([PR 16571](https://github.com/dotnet/fsharp/pull/16571))
* `implicitCtorSynPats` in `SynTypeDefnSimpleRepr.General` is now `SynPat option` instead of `SynSimplePats option`. ([PR #16425](https://github.com/dotnet/fsharp/pull/16425))
* `SyntaxVisitorBase<'T>.VisitSimplePats` now takes `SynPat` instead of `SynSimplePat list`. ([PR #16425](https://github.com/dotnet/fsharp/pull/16425))
* Reduce allocations in compiler checking via `ValueOption` usage ([PR #16323](https://github.com/dotnet/fsharp/pull/16323))
* Reduce allocations in compiler checking via `ValueOption` usage ([PR #16323](https://github.com/dotnet/fsharp/pull/16323), [PR #16567](https://github.com/dotnet/fsharp/pull/16567))
* Reverted [#16348](https://github.com/dotnet/fsharp/pull/16348) `ThreadStatic` `CancellationToken` changes to improve test stability and prevent potential unwanted cancellations. ([PR #16536](https://github.com/dotnet/fsharp/pull/16536))
* Refactored parenthesization API. ([PR #16461])(https://github.com/dotnet/fsharp/pull/16461))
9 changes: 5 additions & 4 deletions src/Compiler/Optimize/DetupleArgs.fs
Original file line number Diff line number Diff line change
Expand Up @@ -150,14 +150,15 @@ let DetupleRewriteStackGuardDepth = StackGuard.GetDepthOption "DetupleRewrite"


// Merge a tyapp node and and app node.
[<return: Struct>]
let (|TyappAndApp|_|) e =
match e with
| Expr.App(f, fty, tys, args, m) ->
match stripDebugPoints (stripExpr f) with
| Expr.App(f2, fty2, tys2, [], m2) -> Some(f2, fty2, tys2 @ tys, args, m2)
| Expr.App _ -> Some(f, fty, tys, args, m) (* has args, so not combine ty args *)
| f -> Some(f, fty, tys, args, m)
| _ -> None
| Expr.App(f2, fty2, tys2, [], m2) -> ValueSome(f2, fty2, tys2 @ tys, args, m2)
| Expr.App _ -> ValueSome(f, fty, tys, args, m) (* has args, so not combine ty args *)
| f -> ValueSome(f, fty, tys, args, m)
| _ -> ValueNone

[<AutoOpen>]
module GlobalUsageAnalysis =
Expand Down
17 changes: 10 additions & 7 deletions src/Compiler/Optimize/LowerComputedCollections.fs
Original file line number Diff line number Diff line change
Expand Up @@ -230,27 +230,30 @@ let (|OptionalCoerce|) expr =

// Making 'seq' optional means this kicks in for FSharp.Core, see TcArrayOrListComputedExpression
// which only adds a 'seq' call outside of FSharp.Core
[<return: Struct>]
let (|OptionalSeq|_|) g amap expr =
match expr with
// use 'seq { ... }' as an indicator
| Seq g (e, elemTy) ->
Some (e, elemTy)
ValueSome (e, elemTy)
| _ ->
// search for the relevant element type
match tyOfExpr g expr with
| SeqElemTy g amap expr.Range elemTy ->
Some (expr, elemTy)
| _ -> None
ValueSome (expr, elemTy)
| _ -> ValueNone

[<return: Struct>]
let (|SeqToList|_|) g expr =
match expr with
| ValApp g g.seq_to_list_vref (_, [seqExpr], m) -> Some (seqExpr, m)
| _ -> None
| ValApp g g.seq_to_list_vref (_, [seqExpr], m) -> ValueSome (seqExpr, m)
| _ -> ValueNone

[<return: Struct>]
let (|SeqToArray|_|) g expr =
match expr with
| ValApp g g.seq_to_array_vref (_, [seqExpr], m) -> Some (seqExpr, m)
| _ -> None
| ValApp g g.seq_to_array_vref (_, [seqExpr], m) -> ValueSome (seqExpr, m)
| _ -> ValueNone

let LowerComputedListOrArrayExpr tcVal (g: TcGlobals) amap overallExpr =
// If ListCollector is in FSharp.Core then this optimization kicks in
Expand Down
5 changes: 3 additions & 2 deletions src/Compiler/Optimize/LowerSequences.fs
Original file line number Diff line number Diff line change
Expand Up @@ -74,15 +74,16 @@ let tyConfirmsToSeq g ty =
tyconRefEq g tcref g.tcref_System_Collections_Generic_IEnumerable
| _ -> false

[<return: Struct>]
let (|SeqElemTy|_|) g amap m ty =
match SearchEntireHierarchyOfType (tyConfirmsToSeq g) g amap m ty with
| None ->
// printfn "FAILED - yield! did not yield a sequence! %s" (stringOfRange m)
None
ValueNone
| Some seqTy ->
// printfn "found yield!"
let inpElemTy = List.head (argsOfAppTy g seqTy)
Some inpElemTy
ValueSome inpElemTy

/// Analyze a TAST expression to detect the elaborated form of a sequence expression.
/// Then compile it to a state machine represented as a TAST containing goto, return and label nodes.
Expand Down
3 changes: 2 additions & 1 deletion src/Compiler/Optimize/LowerSequences.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,8 @@ open FSharp.Compiler.TypedTree
open FSharp.Compiler.Text

/// Detect a 'seq<int>' type
val (|SeqElemTy|_|): TcGlobals -> ImportMap -> range -> TType -> TType option
[<return: Struct>]
val (|SeqElemTy|_|): TcGlobals -> ImportMap -> range -> TType -> TType voption

val callNonOverloadedILMethod:
g: TcGlobals -> amap: ImportMap -> m: range -> methName: string -> ty: TType -> args: Exprs -> Expr
Expand Down
5 changes: 3 additions & 2 deletions src/Compiler/Optimize/LowerStateMachines.fs
Original file line number Diff line number Diff line change
Expand Up @@ -377,6 +377,7 @@ type LowerStateMachine(g: TcGlobals) =
| None -> env2, expr2

// Detect a state machine with a single method override
[<return: Struct>]
let (|ExpandedStateMachineInContext|_|) inputExpr =
// All expanded resumable code state machines e.g. 'task { .. }' begin with a bind of @builder or 'defn'
let env, expr = BindResumableCodeDefinitions env.Empty inputExpr
Expand Down Expand Up @@ -405,9 +406,9 @@ type LowerStateMachine(g: TcGlobals) =
(moveNextThisVar, moveNextExprR),
(setStateMachineThisVar, setStateMachineStateVar, setStateMachineBodyR),
(afterCodeThisVar, afterCodeBodyR))
Some (env, remake2, moveNextBody)
ValueSome (env, remake2, moveNextBody)
| _ ->
None
ValueNone

// A utility to add a jump table an expression
let addPcJumpTable m (pcs: int list) (pc2lab: Map<int, ILCodeLabel>) pcExpr expr =
Expand Down
84 changes: 50 additions & 34 deletions src/Compiler/Optimize/Optimizer.fs
Original file line number Diff line number Diff line change
Expand Up @@ -703,15 +703,17 @@ let rec stripValue = function
| SizeValue(_, details) -> stripValue details (* step through SizeValue "aliases" *)
| vinfo -> vinfo

[<return: Struct>]
let (|StripConstValue|_|) ev =
match stripValue ev with
| ConstValue(c, _) -> Some c
| _ -> None
| ConstValue(c, _) -> ValueSome c
| _ -> ValueNone

[<return: Struct>]
let (|StripLambdaValue|_|) ev =
match stripValue ev with
| CurriedLambdaValue (id, arity, sz, expr, ty) -> Some (id, arity, sz, expr, ty)
| _ -> None
| CurriedLambdaValue (id, arity, sz, expr, ty) -> ValueSome (id, arity, sz, expr, ty)
| _ -> ValueNone

let destTupleValue ev =
match stripValue ev with
Expand All @@ -723,10 +725,11 @@ let destRecdValue ev =
| RecdValue (_tcref, info) -> Some info
| _ -> None

[<return: Struct>]
let (|StripUnionCaseValue|_|) ev =
match stripValue ev with
| UnionCaseValue (c, info) -> Some (c, info)
| _ -> None
| UnionCaseValue (c, info) -> ValueSome (c, info)
| _ -> ValueNone

let mkBoolVal (g: TcGlobals) n = ConstValue(Const.Bool n, g.bool_ty)

Expand Down Expand Up @@ -1764,26 +1767,29 @@ let TryEliminateLet cenv env bind e2 m =
| None -> mkLetBind m bind e2, 0

/// Detect the application of a value to an arbitrary number of arguments
[<return: Struct>]
let rec (|KnownValApp|_|) expr =
match stripDebugPoints expr with
| Expr.Val (vref, _, _) -> Some(vref, [], [])
| Expr.App (KnownValApp(vref, typeArgs1, otherArgs1), _, typeArgs2, otherArgs2, _) -> Some(vref, typeArgs1@typeArgs2, otherArgs1@otherArgs2)
| _ -> None
| Expr.Val (vref, _, _) -> ValueSome(vref, [], [])
| Expr.App (KnownValApp(vref, typeArgs1, otherArgs1), _, typeArgs2, otherArgs2, _) -> ValueSome(vref, typeArgs1@typeArgs2, otherArgs1@otherArgs2)
| _ -> ValueNone

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

/// Check target that have a constant bool value
[<return: Struct>]
let (|ConstantBoolTarget|_|) target =
match target with
| TTarget([], Expr.Const (Const.Bool b, _, _), _) -> Some b
| _ -> None
| TTarget([], Expr.Const (Const.Bool b, _, _), _) -> ValueSome b
| _ -> ValueNone

/// 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
Expand Down Expand Up @@ -2053,50 +2059,59 @@ let ExpandStructuralBinding cenv expr =
ExpandStructuralBindingRaw cenv e

/// Detect a query { ... }
[<return: Struct>]
let (|QueryRun|_|) g expr =
match expr with
| Expr.App (Expr.Val (vref, _, _), _, _, [_builder; arg], _) when valRefEq g vref g.query_run_value_vref ->
Some (arg, None)
ValueSome (arg, None)
| Expr.App (Expr.Val (vref, _, _), _, [ elemTy ], [_builder; arg], _) when valRefEq g vref g.query_run_enumerable_vref ->
Some (arg, Some elemTy)
ValueSome (arg, Some elemTy)
| _ ->
None
ValueNone

let (|MaybeRefTupled|) e = tryDestRefTupleExpr e

[<return: Struct>]
let (|AnyInstanceMethodApp|_|) e =
match e with
| Expr.App (Expr.Val (vref, _, _), _, tyargs, [obj; MaybeRefTupled args], _) -> Some (vref, tyargs, obj, args)
| _ -> None
| Expr.App (Expr.Val (vref, _, _), _, tyargs, [obj; MaybeRefTupled args], _) -> ValueSome (vref, tyargs, obj, args)
| _ -> ValueNone

[<return: Struct>]
let (|InstanceMethodApp|_|) g (expectedValRef: ValRef) e =
match e with
| AnyInstanceMethodApp (vref, tyargs, obj, args) when valRefEq g vref expectedValRef -> Some (tyargs, obj, args)
| _ -> None
| AnyInstanceMethodApp (vref, tyargs, obj, args) when valRefEq g vref expectedValRef -> ValueSome (tyargs, obj, args)
| _ -> ValueNone

[<return: Struct>]
let (|QuerySourceEnumerable|_|) g = function
| InstanceMethodApp g g.query_source_vref ([resTy], _builder, [res]) -> Some (resTy, res)
| _ -> None
| InstanceMethodApp g g.query_source_vref ([resTy], _builder, [res]) -> ValueSome (resTy, res)
| _ -> ValueNone

[<return: Struct>]
let (|QueryFor|_|) g = function
| InstanceMethodApp g g.query_for_vref ([srcTy;qTy;resTy;_qInnerTy], _builder, [src;selector]) -> Some (qTy, srcTy, resTy, src, selector)
| _ -> None
| InstanceMethodApp g g.query_for_vref ([srcTy;qTy;resTy;_qInnerTy], _builder, [src;selector]) -> ValueSome (qTy, srcTy, resTy, src, selector)
| _ -> ValueNone

[<return: Struct>]
let (|QueryYield|_|) g = function
| InstanceMethodApp g g.query_yield_vref ([resTy;qTy], _builder, [res]) -> Some (qTy, resTy, res)
| _ -> None
| InstanceMethodApp g g.query_yield_vref ([resTy;qTy], _builder, [res]) -> ValueSome (qTy, resTy, res)
| _ -> ValueNone

[<return: Struct>]
let (|QueryYieldFrom|_|) g = function
| InstanceMethodApp g g.query_yield_from_vref ([resTy;qTy], _builder, [res]) -> Some (qTy, resTy, res)
| _ -> None
| InstanceMethodApp g g.query_yield_from_vref ([resTy;qTy], _builder, [res]) -> ValueSome (qTy, resTy, res)
| _ -> ValueNone

[<return: Struct>]
let (|QuerySelect|_|) g = function
| InstanceMethodApp g g.query_select_vref ([srcTy;qTy;resTy], _builder, [src;selector]) -> Some (qTy, srcTy, resTy, src, selector)
| _ -> None
| InstanceMethodApp g g.query_select_vref ([srcTy;qTy;resTy], _builder, [src;selector]) -> ValueSome (qTy, srcTy, resTy, src, selector)
| _ -> ValueNone

[<return: Struct>]
let (|QueryZero|_|) g = function
| InstanceMethodApp g g.query_zero_vref ([resTy;qTy], _builder, _) -> Some (qTy, resTy)
| _ -> None
| InstanceMethodApp g g.query_zero_vref ([resTy;qTy], _builder, _) -> ValueSome (qTy, resTy)
| _ -> ValueNone

/// Look for a possible tuple and transform
let (|AnyRefTupleTrans|) e =
Expand All @@ -2105,11 +2120,12 @@ let (|AnyRefTupleTrans|) e =
| _ -> [e], (function [e] -> e | _ -> assert false; failwith "unreachable")

/// Look for any QueryBuilder.* operation and transform
[<return: Struct>]
let (|AnyQueryBuilderOpTrans|_|) g = function
| Expr.App (Expr.Val (vref, _, _) as v, vty, tyargs, [builder; AnyRefTupleTrans( src :: rest, replaceArgs) ], m) when
(match vref.ApparentEnclosingEntity with Parent tcref -> tyconRefEq g tcref g.query_builder_tcref | ParentNone -> false) ->
Some (src, (fun newSource -> Expr.App (v, vty, tyargs, [builder; replaceArgs(newSource :: rest)], m)))
| _ -> None
ValueSome (src, (fun newSource -> Expr.App (v, vty, tyargs, [builder; replaceArgs(newSource :: rest)], m)))
| _ -> ValueNone

/// If this returns "Some" then the source is not IQueryable.
// <qexprInner> :=
Expand Down
4 changes: 2 additions & 2 deletions src/Compiler/Service/ServiceLexing.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1042,8 +1042,8 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, maxLength: int option, fi
false, (RQUOTE(s, raw), leftc, rightc - 1)
| INFIX_COMPARE_OP(LexFilter.TyparsCloseOp(greaters, afterOp) as opstr) ->
match afterOp with
| None -> ()
| Some tok -> delayToken (tok, leftc + greaters.Length, rightc)
| ValueNone -> ()
| ValueSome tok -> delayToken (tok, leftc + greaters.Length, rightc)

for i = greaters.Length - 1 downto 1 do
delayToken (greaters[i]false, leftc + i, rightc - opstr.Length + i + 1)
Expand Down
Loading

0 comments on commit 1b50168

Please sign in to comment.