From 15e41c7e525316ff10f4bd9149821934abef52e5 Mon Sep 17 00:00:00 2001 From: Petr Date: Mon, 22 Jan 2024 13:53:24 +0100 Subject: [PATCH 1/5] More ValueOption in complier: part 2 --- src/Compiler/Optimize/DetupleArgs.fs | 9 +- .../Optimize/LowerComputedCollections.fs | 17 ++-- src/Compiler/Optimize/LowerSequences.fs | 5 +- src/Compiler/Optimize/LowerSequences.fsi | 3 +- src/Compiler/Optimize/LowerStateMachines.fs | 5 +- src/Compiler/Optimize/Optimizer.fs | 84 +++++++++++-------- src/Compiler/Service/ServiceLexing.fs | 4 +- src/Compiler/SyntaxTree/LexFilter.fs | 73 ++++++++-------- src/Compiler/SyntaxTree/LexFilter.fsi | 3 +- src/Compiler/SyntaxTree/SyntaxTreeOps.fs | 77 ++++++++++------- src/Compiler/SyntaxTree/SyntaxTreeOps.fsi | 33 +++++--- 11 files changed, 182 insertions(+), 131 deletions(-) diff --git a/src/Compiler/Optimize/DetupleArgs.fs b/src/Compiler/Optimize/DetupleArgs.fs index 0021357366c..a1655bafb0b 100644 --- a/src/Compiler/Optimize/DetupleArgs.fs +++ b/src/Compiler/Optimize/DetupleArgs.fs @@ -150,14 +150,15 @@ let DetupleRewriteStackGuardDepth = StackGuard.GetDepthOption "DetupleRewrite" // Merge a tyapp node and and app node. +[] 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 [] module GlobalUsageAnalysis = diff --git a/src/Compiler/Optimize/LowerComputedCollections.fs b/src/Compiler/Optimize/LowerComputedCollections.fs index f2f3e4f6245..2de57119ff3 100644 --- a/src/Compiler/Optimize/LowerComputedCollections.fs +++ b/src/Compiler/Optimize/LowerComputedCollections.fs @@ -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 +[] 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 +[] 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 +[] 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 diff --git a/src/Compiler/Optimize/LowerSequences.fs b/src/Compiler/Optimize/LowerSequences.fs index 3a7d733ec59..64686d0fe62 100644 --- a/src/Compiler/Optimize/LowerSequences.fs +++ b/src/Compiler/Optimize/LowerSequences.fs @@ -74,15 +74,16 @@ let tyConfirmsToSeq g ty = tyconRefEq g tcref g.tcref_System_Collections_Generic_IEnumerable | _ -> false +[] 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. diff --git a/src/Compiler/Optimize/LowerSequences.fsi b/src/Compiler/Optimize/LowerSequences.fsi index aa675cda5c0..61ed7d87766 100644 --- a/src/Compiler/Optimize/LowerSequences.fsi +++ b/src/Compiler/Optimize/LowerSequences.fsi @@ -9,7 +9,8 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.Text /// Detect a 'seq' type -val (|SeqElemTy|_|): TcGlobals -> ImportMap -> range -> TType -> TType option +[] +val (|SeqElemTy|_|): TcGlobals -> ImportMap -> range -> TType -> TType voption val callNonOverloadedILMethod: g: TcGlobals -> amap: ImportMap -> m: range -> methName: string -> ty: TType -> args: Exprs -> Expr diff --git a/src/Compiler/Optimize/LowerStateMachines.fs b/src/Compiler/Optimize/LowerStateMachines.fs index ef578e86064..97d212f8854 100644 --- a/src/Compiler/Optimize/LowerStateMachines.fs +++ b/src/Compiler/Optimize/LowerStateMachines.fs @@ -377,6 +377,7 @@ type LowerStateMachine(g: TcGlobals) = | None -> env2, expr2 // Detect a state machine with a single method override + [] 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 @@ -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) pcExpr expr = diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index 73ed2972ea0..0149a159b51 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -703,15 +703,17 @@ let rec stripValue = function | SizeValue(_, details) -> stripValue details (* step through SizeValue "aliases" *) | vinfo -> vinfo +[] let (|StripConstValue|_|) ev = match stripValue ev with - | ConstValue(c, _) -> Some c - | _ -> None + | ConstValue(c, _) -> ValueSome c + | _ -> ValueNone +[] 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 @@ -723,10 +725,11 @@ let destRecdValue ev = | RecdValue (_tcref, info) -> Some info | _ -> None +[] 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) @@ -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 +[] 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. +[] 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 +[] 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 @@ -2053,50 +2059,59 @@ let rec ExpandStructuralBinding cenv expr = ExpandStructuralBindingRaw cenv e /// Detect a query { ... } +[] 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 +[] 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 +[] 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 +[] 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 +[] 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 +[] 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 +[] 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 +[] 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 +[] 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 = @@ -2105,11 +2120,12 @@ let (|AnyRefTupleTrans|) e = | _ -> [e], (function [e] -> e | _ -> assert false; failwith "unreachable") /// Look for any QueryBuilder.* operation and transform +[] 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. // := diff --git a/src/Compiler/Service/ServiceLexing.fs b/src/Compiler/Service/ServiceLexing.fs index e3f4dcc3c4e..66893ac950e 100644 --- a/src/Compiler/Service/ServiceLexing.fs +++ b/src/Compiler/Service/ServiceLexing.fs @@ -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) diff --git a/src/Compiler/SyntaxTree/LexFilter.fs b/src/Compiler/SyntaxTree/LexFilter.fs index 3e7dcfa7262..d6d9a5de5ff 100644 --- a/src/Compiler/SyntaxTree/LexFilter.fs +++ b/src/Compiler/SyntaxTree/LexFilter.fs @@ -182,18 +182,20 @@ let infixTokenLength token = // // LBRACK_LESS and GREATER_RBRACK are not here because adding them in these active patterns // causes more offside warnings, while removing them doesn't add offside warnings in attributes. +[] let (|TokenLExprParen|_|) token = match token with | BEGIN | LPAREN | LBRACE _ | LBRACE_BAR | LBRACK | LBRACK_BAR | LQUOTE _ | LESS true - -> Some () - | _ -> None + -> ValueSome () + | _ -> ValueNone /// Matches against a right-parenthesis-like token that is valid in expressions. +[] let (|TokenRExprParen|_|) token = match token with | END | RPAREN | RBRACE _ | BAR_RBRACE | RBRACK | BAR_RBRACK | RQUOTE _ | GREATER true - -> Some () - | _ -> None + -> ValueSome () + | _ -> ValueNone /// Determine the tokens that may align with the 'if' of an 'if/then/elif/else' without closing /// the construct @@ -514,53 +516,54 @@ type TokenTupPool() = // Strip a bunch of leading '>' of a token, at the end of a typar application // Note: this is used in the 'service.fs' to do limited postprocessing +[] let (|TyparsCloseOp|_|) (txt: string) = let angles = txt |> Seq.takeWhile (fun c -> c = '>') |> Seq.toList let afterAngles = txt |> Seq.skipWhile (fun c -> c = '>') |> Seq.toList - if List.isEmpty angles then None else + if List.isEmpty angles then ValueNone else let afterOp = match (System.String(Array.ofSeq afterAngles)) with - | "." -> Some DOT - | "]" -> Some RBRACK - | "-" -> Some MINUS - | ".." -> Some DOT_DOT - | "?" -> Some QMARK - | "??" -> Some QMARK_QMARK - | ":=" -> Some COLON_EQUALS - | "::" -> Some COLON_COLON - | "*" -> Some STAR - | "&" -> Some AMP - | "->" -> Some RARROW - | "<-" -> Some LARROW - | "=" -> Some EQUALS - | "<" -> Some (LESS false) - | "$" -> Some DOLLAR - | "%" -> Some (PERCENT_OP("%") ) - | "%%" -> Some (PERCENT_OP("%%")) - | s when String.IsNullOrEmpty(s) -> None + | "." -> ValueSome DOT + | "]" -> ValueSome RBRACK + | "-" -> ValueSome MINUS + | ".." -> ValueSome DOT_DOT + | "?" -> ValueSome QMARK + | "??" -> ValueSome QMARK_QMARK + | ":=" -> ValueSome COLON_EQUALS + | "::" -> ValueSome COLON_COLON + | "*" -> ValueSome STAR + | "&" -> ValueSome AMP + | "->" -> ValueSome RARROW + | "<-" -> ValueSome LARROW + | "=" -> ValueSome EQUALS + | "<" -> ValueSome (LESS false) + | "$" -> ValueSome DOLLAR + | "%" -> ValueSome (PERCENT_OP("%") ) + | "%%" -> ValueSome (PERCENT_OP("%%")) + | s when String.IsNullOrEmpty(s) -> ValueNone | s -> match List.ofSeq afterAngles with | '=' :: _ | '!' :: '=' :: _ | '<' :: _ | '>' :: _ - | '$' :: _ -> Some (INFIX_COMPARE_OP s) - | '&' :: _ -> Some (INFIX_AMP_OP s) - | '|' :: _ -> Some (INFIX_BAR_OP s) + | '$' :: _ -> ValueSome (INFIX_COMPARE_OP s) + | '&' :: _ -> ValueSome (INFIX_AMP_OP s) + | '|' :: _ -> ValueSome (INFIX_BAR_OP s) | '!' :: _ | '?' :: _ - | '~' :: _ -> Some (PREFIX_OP s) + | '~' :: _ -> ValueSome (PREFIX_OP s) | '@' :: _ - | '^' :: _ -> Some (INFIX_AT_HAT_OP s) + | '^' :: _ -> ValueSome (INFIX_AT_HAT_OP s) | '+' :: _ - | '-' :: _ -> Some (PLUS_MINUS_OP s) - | '*' :: '*' :: _ -> Some (INFIX_STAR_STAR_OP s) + | '-' :: _ -> ValueSome (PLUS_MINUS_OP s) + | '*' :: '*' :: _ -> ValueSome (INFIX_STAR_STAR_OP s) | '*' :: _ | '/' :: _ - | '%' :: _ -> Some (INFIX_STAR_DIV_MOD_OP s) - | _ -> None - Some([| for _c in angles do yield GREATER |], afterOp) + | '%' :: _ -> ValueSome (INFIX_STAR_DIV_MOD_OP s) + | _ -> ValueNone + ValueSome([| for _c in angles do yield GREATER |], afterOp) [] type PositionWithColumn = @@ -1196,8 +1199,8 @@ type LexFilterImpl ( pool.Return tokenTup | INFIX_COMPARE_OP (TyparsCloseOp(greaters, afterOp) as opstr) -> match afterOp with - | None -> () - | Some tok -> delayToken (pool.UseShiftedLocation(tokenTup, tok, greaters.Length, 0)) + | ValueNone -> () + | ValueSome tok -> delayToken (pool.UseShiftedLocation(tokenTup, tok, greaters.Length, 0)) for i = greaters.Length - 1 downto 0 do delayToken (pool.UseShiftedLocation(tokenTup, greaters[i] res, i, -opstr.Length + i + 1)) pool.Return tokenTup diff --git a/src/Compiler/SyntaxTree/LexFilter.fsi b/src/Compiler/SyntaxTree/LexFilter.fsi index 319fd5ecd90..005d61d1961 100644 --- a/src/Compiler/SyntaxTree/LexFilter.fsi +++ b/src/Compiler/SyntaxTree/LexFilter.fsi @@ -10,7 +10,8 @@ open FSharp.Compiler.Parser /// Match the close of '>' of a set of type parameters. /// This is done for tokens such as '>>' by smashing the token -val (|TyparsCloseOp|_|): txt: string -> ((bool -> token)[] * token option) option +[] +val (|TyparsCloseOp|_|): txt: string -> ((bool -> token)[] * token voption) voption /// A stateful filter over the token stream that adjusts it for indentation-aware syntax rules /// Process the token stream prior to parsing. Implements the offside rule and other lexical transformations. diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs index d44395dbcc1..d6c65234237 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs @@ -104,67 +104,76 @@ let rec pushUnaryArg expr arg = errorR (Error(FSComp.SR.tcDotLambdaAtNotSupportedExpression (), expr.Range)) expr +[] let (|SynSingleIdent|_|) x = match x with - | SynLongIdent([ id ], _, _) -> Some id - | _ -> None + | SynLongIdent([ id ], _, _) -> ValueSome id + | _ -> ValueNone /// Match a long identifier, including the case for single identifiers which gets a more optimized node in the syntax tree. +[] let (|LongOrSingleIdent|_|) inp = match inp with - | SynExpr.LongIdent(isOpt, lidwd, altId, _m) -> Some(isOpt, lidwd, altId, lidwd.RangeWithoutAnyExtraDot) - | SynExpr.Ident id -> Some(false, SynLongIdent([ id ], [], [ None ]), None, id.idRange) + | SynExpr.LongIdent(isOpt, lidwd, altId, _m) -> ValueSome(isOpt, lidwd, altId, lidwd.RangeWithoutAnyExtraDot) + | SynExpr.Ident id -> ValueSome(false, SynLongIdent([ id ], [], [ None ]), None, id.idRange) | SynExpr.DiscardAfterMissingQualificationAfterDot(synExpr, dotRange, _) -> match synExpr with - | SynExpr.Ident ident -> Some(false, SynLongIdent([ ident ], [ dotRange ], [ None ]), None, ident.idRange) + | SynExpr.Ident ident -> ValueSome(false, SynLongIdent([ ident ], [ dotRange ], [ None ]), None, ident.idRange) | SynExpr.LongIdent(false, SynLongIdent(idents, dotRanges, trivia), _, range) -> - Some(false, SynLongIdent(idents, dotRanges @ [ dotRange ], trivia), None, range) - | _ -> None + ValueSome(false, SynLongIdent(idents, dotRanges @ [ dotRange ], trivia), None, range) + | _ -> ValueNone - | _ -> None + | _ -> ValueNone +[] let (|SingleIdent|_|) inp = match inp with - | SynExpr.LongIdent(false, SynSingleIdent(id), None, _) -> Some id - | SynExpr.Ident id -> Some id - | _ -> None + | SynExpr.LongIdent(false, SynSingleIdent(id), None, _) -> ValueSome id + | SynExpr.Ident id -> ValueSome id + | _ -> ValueNone +[] let (|SynBinOp|_|) input = match input with | SynExpr.App(ExprAtomicFlag.NonAtomic, false, SynExpr.App(ExprAtomicFlag.NonAtomic, true, SynExpr.LongIdent(longDotId = SynLongIdent(id = [ synId ])), x1, _m1), x2, - _m2) -> Some(synId, x1, x2) - | _ -> None + _m2) -> ValueSome(synId, x1, x2) + | _ -> ValueNone +[] let (|SynPipeRight|_|) input = match input with - | SynBinOp(synId, x1, x2) when synId.idText = "op_PipeRight" -> Some(x1, x2) - | _ -> None + | SynBinOp(synId, x1, x2) when synId.idText = "op_PipeRight" -> ValueSome(x1, x2) + | _ -> ValueNone +[] let (|SynPipeRight2|_|) input = match input with | SynBinOp(synId, SynExpr.Paren(SynExpr.Tuple(false, [ x1a; x1b ], _, _), _, _, _), x2) when synId.idText = "op_PipeRight2" -> - Some(x1a, x1b, x2) - | _ -> None + ValueSome(x1a, x1b, x2) + | _ -> ValueNone +[] let (|SynPipeRight3|_|) input = match input with | SynBinOp(synId, SynExpr.Paren(SynExpr.Tuple(false, [ x1a; x1b; x1c ], _, _), _, _, _), x2) when synId.idText = "op_PipeRight3" -> - Some(x1a, x1b, x1c, x2) - | _ -> None + ValueSome(x1a, x1b, x1c, x2) + | _ -> ValueNone +[] let (|SynAndAlso|_|) input = match input with - | SynBinOp(synId, x1, x2) when synId.idText = "op_BooleanAnd" -> Some(x1, x2) - | _ -> None + | SynBinOp(synId, x1, x2) when synId.idText = "op_BooleanAnd" -> ValueSome(x1, x2) + | _ -> ValueNone +[] let (|SynOrElse|_|) input = match input with - | SynBinOp(synId, x1, x2) when synId.idText = "op_BooleanOr" -> Some(x1, x2) - | _ -> None + | SynBinOp(synId, x1, x2) when synId.idText = "op_BooleanOr" -> ValueSome(x1, x2) + | _ -> ValueNone /// This affects placement of debug points let rec IsControlFlowExpression e = @@ -237,26 +246,29 @@ let mkSynPatMaybeVar lidwd vis m = SynPat.LongIdent(lidwd, None, None, SynArgPats.Pats [], vis, m) /// Extract the argument for patterns corresponding to the declaration of 'new ... = ...' +[] let (|SynPatForConstructorDecl|_|) x = match x with - | SynPat.LongIdent(longDotId = SynSingleIdent _; argPats = SynArgPats.Pats [ arg ]) -> Some arg - | _ -> None + | SynPat.LongIdent(longDotId = SynSingleIdent _; argPats = SynArgPats.Pats [ arg ]) -> ValueSome arg + | _ -> ValueNone /// Recognize the '()' in 'new()' +[] let (|SynPatForNullaryArgs|_|) x = match x with - | SynPat.Paren(SynPat.Const(SynConst.Unit, _), _) -> Some() - | _ -> None + | SynPat.Paren(SynPat.Const(SynConst.Unit, _), _) -> ValueSome() + | _ -> ValueNone let (|SynExprErrorSkip|) (p: SynExpr) = match p with | SynExpr.FromParseError(p, _) -> p | _ -> p +[] let (|SynExprParen|_|) (e: SynExpr) = match e with - | SynExpr.Paren(SynExprErrorSkip e, a, b, c) -> Some(e, a, b, c) - | _ -> None + | SynExpr.Paren(SynExprErrorSkip e, a, b, c) -> ValueSome(e, a, b, c) + | _ -> ValueNone let (|SynPatErrorSkip|) (p: SynPat) = match p with @@ -1025,6 +1037,7 @@ let getTypeFromTuplePath (path: SynTupleTypeSegment list) : SynType list = | SynTupleTypeSegment.Type t -> Some t | _ -> None) +[] let (|MultiDimensionArrayType|_|) (t: SynType) = match t with | SynType.App(StripParenTypes(SynType.LongIdent(SynLongIdent([ identifier ], _, _))), _, [ elementType ], _, _, true, m) -> @@ -1036,10 +1049,10 @@ let (|MultiDimensionArrayType|_|) (t: SynType) = |> System.String |> int - Some(rank, elementType, m) + ValueSome(rank, elementType, m) else - None - | _ -> None + ValueNone + | _ -> ValueNone let (|TypesForTypar|) (t: SynType) = let rec visit continuation t = diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi b/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi index 03fc0be628d..5ee198564ed 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi @@ -44,10 +44,12 @@ val mkSynCompGenSimplePatVar: id: Ident -> SynSimplePat val pushUnaryArg: expr: SynExpr -> arg: Ident -> SynExpr /// Match a long identifier, including the case for single identifiers which gets a more optimized node in the syntax tree. +[] val (|LongOrSingleIdent|_|): - inp: SynExpr -> (bool * SynLongIdent * SynSimplePatAlternativeIdInfo ref option * range) option + inp: SynExpr -> (bool * SynLongIdent * SynSimplePatAlternativeIdInfo ref option * range) voption -val (|SingleIdent|_|): inp: SynExpr -> Ident option +[] +val (|SingleIdent|_|): inp: SynExpr -> Ident voption /// This affects placement of debug points val IsControlFlowExpression: e: SynExpr -> bool @@ -66,14 +68,17 @@ val mkSynThisPatVar: id: Ident -> SynPat val mkSynPatMaybeVar: lidwd: SynLongIdent -> vis: SynAccess option -> m: range -> SynPat -val (|SynPatForConstructorDecl|_|): x: SynPat -> SynPat option +[] +val (|SynPatForConstructorDecl|_|): x: SynPat -> SynPat voption /// Recognize the '()' in 'new()' -val (|SynPatForNullaryArgs|_|): x: SynPat -> unit option +[] +val (|SynPatForNullaryArgs|_|): x: SynPat -> unit voption val (|SynExprErrorSkip|): p: SynExpr -> SynExpr -val (|SynExprParen|_|): e: SynExpr -> (SynExpr * range * range option * range) option +[] +val (|SynExprParen|_|): e: SynExpr -> (SynExpr * range * range option * range) voption val (|SynPatErrorSkip|): p: SynPat -> SynPat @@ -317,19 +322,24 @@ val synExprContainsError: inpExpr: SynExpr -> bool val (|ParsedHashDirectiveArguments|): ParsedHashDirectiveArgument list -> string list /// 'e1 && e2' -val (|SynAndAlso|_|): SynExpr -> (SynExpr * SynExpr) option +[] +val (|SynAndAlso|_|): SynExpr -> (SynExpr * SynExpr) voption /// 'e1 || e2' -val (|SynOrElse|_|): SynExpr -> (SynExpr * SynExpr) option +[] +val (|SynOrElse|_|): SynExpr -> (SynExpr * SynExpr) voption /// 'e1 |> e2' -val (|SynPipeRight|_|): SynExpr -> (SynExpr * SynExpr) option +[] +val (|SynPipeRight|_|): SynExpr -> (SynExpr * SynExpr) voption /// 'e1 ||> e2' -val (|SynPipeRight2|_|): SynExpr -> (SynExpr * SynExpr * SynExpr) option +[] +val (|SynPipeRight2|_|): SynExpr -> (SynExpr * SynExpr * SynExpr) voption /// 'e1 |||> e2' -val (|SynPipeRight3|_|): SynExpr -> (SynExpr * SynExpr * SynExpr * SynExpr) option +[] +val (|SynPipeRight3|_|): SynExpr -> (SynExpr * SynExpr * SynExpr * SynExpr) voption val prependIdentInLongIdentWithTrivia: ident: SynIdent -> mDot: range -> lid: SynLongIdent -> SynLongIdent @@ -341,6 +351,7 @@ val desugarGetSetMembers: memberDefns: SynMemberDefns -> SynMemberDefns val getTypeFromTuplePath: path: SynTupleTypeSegment list -> SynType list -val (|MultiDimensionArrayType|_|): t: SynType -> (int * SynType * range) option +[] +val (|MultiDimensionArrayType|_|): t: SynType -> (int * SynType * range) voption val (|TypesForTypar|): t: SynType -> SynType list From 6f2e4614bcc37aa05586a804ef8bc54fdd65c033 Mon Sep 17 00:00:00 2001 From: Petr Date: Tue, 23 Jan 2024 15:49:36 +0100 Subject: [PATCH 2/5] Update release notes --- docs/release-notes/.FSharp.Compiler.Service/8.0.300.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md index dce836b32be..1bc85ed394f 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md @@ -13,6 +13,6 @@ * `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)) From 7421188fed5a6e49338d4973667eaec27f4ed21e Mon Sep 17 00:00:00 2001 From: Petr Date: Tue, 23 Jan 2024 16:14:27 +0100 Subject: [PATCH 3/5] extra optimization --- src/Compiler/SyntaxTree/LexFilter.fs | 104 +++++++++++++----------- src/Compiler/Utilities/ReadOnlySpan.fs | 12 +++ src/Compiler/Utilities/ReadOnlySpan.fsi | 3 + 3 files changed, 73 insertions(+), 46 deletions(-) diff --git a/src/Compiler/SyntaxTree/LexFilter.fs b/src/Compiler/SyntaxTree/LexFilter.fs index d6d9a5de5ff..98be4654941 100644 --- a/src/Compiler/SyntaxTree/LexFilter.fs +++ b/src/Compiler/SyntaxTree/LexFilter.fs @@ -514,56 +514,68 @@ type TokenTupPool() = // Utilities for the tokenizer that are needed in other places //--------------------------------------------------------------------------*) +[] +let (|Equals|_|) (s: string) (span: ReadOnlySpan) = + if span.SequenceEqual(s.AsSpan()) then ValueSome Equals + else ValueNone + +[] +let (|StartsWith|_|) (s: string) (span: ReadOnlySpan) = + if span.StartsWith(s.AsSpan()) then ValueSome StartsWith + else ValueNone + // Strip a bunch of leading '>' of a token, at the end of a typar application // Note: this is used in the 'service.fs' to do limited postprocessing [] let (|TyparsCloseOp|_|) (txt: string) = - let angles = txt |> Seq.takeWhile (fun c -> c = '>') |> Seq.toList - let afterAngles = txt |> Seq.skipWhile (fun c -> c = '>') |> Seq.toList - if List.isEmpty angles then ValueNone else - - let afterOp = - match (System.String(Array.ofSeq afterAngles)) with - | "." -> ValueSome DOT - | "]" -> ValueSome RBRACK - | "-" -> ValueSome MINUS - | ".." -> ValueSome DOT_DOT - | "?" -> ValueSome QMARK - | "??" -> ValueSome QMARK_QMARK - | ":=" -> ValueSome COLON_EQUALS - | "::" -> ValueSome COLON_COLON - | "*" -> ValueSome STAR - | "&" -> ValueSome AMP - | "->" -> ValueSome RARROW - | "<-" -> ValueSome LARROW - | "=" -> ValueSome EQUALS - | "<" -> ValueSome (LESS false) - | "$" -> ValueSome DOLLAR - | "%" -> ValueSome (PERCENT_OP("%") ) - | "%%" -> ValueSome (PERCENT_OP("%%")) - | s when String.IsNullOrEmpty(s) -> ValueNone - | s -> - match List.ofSeq afterAngles with - | '=' :: _ - | '!' :: '=' :: _ - | '<' :: _ - | '>' :: _ - | '$' :: _ -> ValueSome (INFIX_COMPARE_OP s) - | '&' :: _ -> ValueSome (INFIX_AMP_OP s) - | '|' :: _ -> ValueSome (INFIX_BAR_OP s) - | '!' :: _ - | '?' :: _ - | '~' :: _ -> ValueSome (PREFIX_OP s) - | '@' :: _ - | '^' :: _ -> ValueSome (INFIX_AT_HAT_OP s) - | '+' :: _ - | '-' :: _ -> ValueSome (PLUS_MINUS_OP s) - | '*' :: '*' :: _ -> ValueSome (INFIX_STAR_STAR_OP s) - | '*' :: _ - | '/' :: _ - | '%' :: _ -> ValueSome (INFIX_STAR_DIV_MOD_OP s) - | _ -> ValueNone - ValueSome([| for _c in angles do yield GREATER |], afterOp) + if not (txt.StartsWith ">") then + ValueNone + else + match txt.AsSpan().IndexOfAnyExcept '>' with + | -1 -> ValueSome(Array.init txt.Length (fun _ -> GREATER), ValueNone) + | angles -> + let afterAngles = txt.AsSpan angles + + let afterOp = + match afterAngles with + | Equals "." -> ValueSome DOT + | Equals "]" -> ValueSome RBRACK + | Equals "-" -> ValueSome MINUS + | Equals ".." -> ValueSome DOT_DOT + | Equals "?" -> ValueSome QMARK + | Equals "??" -> ValueSome QMARK_QMARK + | Equals ":=" -> ValueSome COLON_EQUALS + | Equals "::" -> ValueSome COLON_COLON + | Equals "*" -> ValueSome STAR + | Equals "&" -> ValueSome AMP + | Equals "->" -> ValueSome RARROW + | Equals "<-" -> ValueSome LARROW + | Equals "=" -> ValueSome EQUALS + | Equals "<" -> ValueSome (LESS false) + | Equals "$" -> ValueSome DOLLAR + | Equals "%" -> ValueSome (PERCENT_OP "%") + | Equals "%%" -> ValueSome (PERCENT_OP "%%") + | StartsWith "=" + | StartsWith "!=" + | StartsWith "<" + | StartsWith ">" + | StartsWith "$" -> ValueSome (INFIX_COMPARE_OP (afterAngles.ToString())) + | StartsWith "&" -> ValueSome (INFIX_AMP_OP (afterAngles.ToString())) + | StartsWith "|" -> ValueSome (INFIX_BAR_OP (afterAngles.ToString())) + | StartsWith "!" + | StartsWith "?" + | StartsWith "~" -> ValueSome (PREFIX_OP (afterAngles.ToString())) + | StartsWith "@" + | StartsWith "^" -> ValueSome (INFIX_AT_HAT_OP (afterAngles.ToString())) + | StartsWith "+" + | StartsWith "-" -> ValueSome (PLUS_MINUS_OP (afterAngles.ToString())) + | StartsWith "**" -> ValueSome (INFIX_STAR_STAR_OP (afterAngles.ToString())) + | StartsWith "*" + | StartsWith "/" + | StartsWith "%" -> ValueSome (INFIX_STAR_DIV_MOD_OP (afterAngles.ToString())) + | _ -> ValueNone + + ValueSome(Array.init angles (fun _ -> GREATER), afterOp) [] type PositionWithColumn = diff --git a/src/Compiler/Utilities/ReadOnlySpan.fs b/src/Compiler/Utilities/ReadOnlySpan.fs index ec673f18fd3..05683eadb9e 100644 --- a/src/Compiler/Utilities/ReadOnlySpan.fs +++ b/src/Compiler/Utilities/ReadOnlySpan.fs @@ -34,6 +34,18 @@ type ReadOnlySpanExtensions = if found then i else -1 + [] + static member IndexOfAnyExcept(span: ReadOnlySpan, value: char) = + let mutable i = 0 + let mutable found = false + + while not found && i < span.Length do + let c = span[i] + + if c <> value then found <- true else i <- i + 1 + + if found then i else -1 + [] static member LastIndexOfAnyInRange(span: ReadOnlySpan, lowInclusive: char, highInclusive: char) = let mutable i = span.Length - 1 diff --git a/src/Compiler/Utilities/ReadOnlySpan.fsi b/src/Compiler/Utilities/ReadOnlySpan.fsi index 875ffba28ad..a43d566e52b 100644 --- a/src/Compiler/Utilities/ReadOnlySpan.fsi +++ b/src/Compiler/Utilities/ReadOnlySpan.fsi @@ -11,6 +11,9 @@ type internal ReadOnlySpanExtensions = [] static member IndexOfAnyExcept: span: ReadOnlySpan * values: ReadOnlySpan -> int + + [] + static member IndexOfAnyExcept: span: ReadOnlySpan * value: char -> int [] static member LastIndexOfAnyInRange: span: ReadOnlySpan * lowInclusive: char * highInclusive: char -> int From c8395a7b3d9fd654c3b27e474a5083c02afc85a9 Mon Sep 17 00:00:00 2001 From: Petr Date: Tue, 23 Jan 2024 16:22:24 +0100 Subject: [PATCH 4/5] extra optimization 2 --- src/Compiler/SyntaxTree/LexFilter.fs | 4 ++-- src/Compiler/SyntaxTree/LexFilter.fsi | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Compiler/SyntaxTree/LexFilter.fs b/src/Compiler/SyntaxTree/LexFilter.fs index 98be4654941..79afdca04c3 100644 --- a/src/Compiler/SyntaxTree/LexFilter.fs +++ b/src/Compiler/SyntaxTree/LexFilter.fs @@ -532,7 +532,7 @@ let (|TyparsCloseOp|_|) (txt: string) = ValueNone else match txt.AsSpan().IndexOfAnyExcept '>' with - | -1 -> ValueSome(Array.init txt.Length (fun _ -> GREATER), ValueNone) + | -1 -> ValueSome(struct (Array.init txt.Length (fun _ -> GREATER), ValueNone)) | angles -> let afterAngles = txt.AsSpan angles @@ -575,7 +575,7 @@ let (|TyparsCloseOp|_|) (txt: string) = | StartsWith "%" -> ValueSome (INFIX_STAR_DIV_MOD_OP (afterAngles.ToString())) | _ -> ValueNone - ValueSome(Array.init angles (fun _ -> GREATER), afterOp) + ValueSome(struct (Array.init angles (fun _ -> GREATER), afterOp)) [] type PositionWithColumn = diff --git a/src/Compiler/SyntaxTree/LexFilter.fsi b/src/Compiler/SyntaxTree/LexFilter.fsi index 005d61d1961..7d39b8325df 100644 --- a/src/Compiler/SyntaxTree/LexFilter.fsi +++ b/src/Compiler/SyntaxTree/LexFilter.fsi @@ -11,7 +11,7 @@ open FSharp.Compiler.Parser /// Match the close of '>' of a set of type parameters. /// This is done for tokens such as '>>' by smashing the token [] -val (|TyparsCloseOp|_|): txt: string -> ((bool -> token)[] * token voption) voption +val (|TyparsCloseOp|_|): txt: string -> struct ((bool -> token)[] * token voption) voption /// A stateful filter over the token stream that adjusts it for indentation-aware syntax rules /// Process the token stream prior to parsing. Implements the offside rule and other lexical transformations. From 944964969a1cb3a82b329e6ec15aa41d31a8eb5d Mon Sep 17 00:00:00 2001 From: Petr Date: Tue, 23 Jan 2024 17:11:58 +0100 Subject: [PATCH 5/5] fantomas --- src/Compiler/Utilities/ReadOnlySpan.fsi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Utilities/ReadOnlySpan.fsi b/src/Compiler/Utilities/ReadOnlySpan.fsi index a43d566e52b..67591a03f88 100644 --- a/src/Compiler/Utilities/ReadOnlySpan.fsi +++ b/src/Compiler/Utilities/ReadOnlySpan.fsi @@ -11,9 +11,9 @@ type internal ReadOnlySpanExtensions = [] static member IndexOfAnyExcept: span: ReadOnlySpan * values: ReadOnlySpan -> int - + [] - static member IndexOfAnyExcept: span: ReadOnlySpan * value: char -> int + static member IndexOfAnyExcept: span: ReadOnlySpan * value: char -> int [] static member LastIndexOfAnyInRange: span: ReadOnlySpan * lowInclusive: char * highInclusive: char -> int