More ValueOption in compiler: part 1

docs/release-notes/.FSharp.Compiler.Service/8.0.300.md

@@ -9,4 +9,5 @@
 ### Changed
 
 * `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))
+* `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))

src/Compiler/Checking/CheckComputationExpressions.fs

@@ -43,21 +43,23 @@ let TryFindIntrinsicOrExtensionMethInfo collectionSettings (cenv: cenv) (env: Tc
 /// Ignores an attribute
 let IgnoreAttribute _ = None
 
+[<return: Struct>]
 let (|ExprAsPat|_|) (f: SynExpr) =
     match f with
     | SingleIdent v1
-    | SynExprParen(SingleIdent v1, _, _, _) -> Some(mkSynPatVar None v1)
+    | SynExprParen(SingleIdent v1, _, _, _) -> ValueSome(mkSynPatVar None v1)
     | SynExprParen(SynExpr.Tuple(false, elems, commas, _), _, _, _) ->
         let elems = elems |> List.map (|SingleIdent|_|)
 
         if elems |> List.forall (fun x -> x.IsSome) then
-            Some(SynPat.Tuple(false, (elems |> List.map (fun x -> mkSynPatVar None x.Value)), commas, f.Range))
+            ValueSome(SynPat.Tuple(false, (elems |> List.map (fun x -> mkSynPatVar None x.Value)), commas, f.Range))
         else
-            None
-    | _ -> None
+            ValueNone
+    | _ -> ValueNone
 
 // For join clauses that join on nullable, we syntactically insert the creation of nullable values on the appropriate side of the condition,
 // then pull the syntax apart again
+[<return: Struct>]
 let (|JoinRelation|_|) cenv env (expr: SynExpr) =
     let m = expr.Range
     let ad = env.eAccessRights
@@ -79,27 +81,27 @@ let (|JoinRelation|_|) cenv env (expr: SynExpr) =
            | _ -> false
 
     match expr with
-    | BinOpExpr(opId, a, b) when isOpName opNameEquals cenv.g.equals_operator_vref opId.idText -> Some(a, b)
+    | BinOpExpr(opId, a, b) when isOpName opNameEquals cenv.g.equals_operator_vref opId.idText -> ValueSome(a, b)
 
     | BinOpExpr(opId, a, b) when isOpName opNameEqualsNullable cenv.g.equals_nullable_operator_vref opId.idText ->
 
         let a =
             SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet a.Range [ MangledGlobalName; "System" ] "Nullable", a, a.Range)
 
-        Some(a, b)
+        ValueSome(a, b)
 
     | BinOpExpr(opId, a, b) when isOpName opNameNullableEquals cenv.g.nullable_equals_operator_vref opId.idText ->
 
         let b =
             SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet b.Range [ MangledGlobalName; "System" ] "Nullable", b, b.Range)
 
-        Some(a, b)
+        ValueSome(a, b)
 
     | BinOpExpr(opId, a, b) when isOpName opNameNullableEqualsNullable cenv.g.nullable_equals_nullable_operator_vref opId.idText ->
 
-        Some(a, b)
+        ValueSome(a, b)
 
-    | _ -> None
+    | _ -> ValueNone
 
 let elimFastIntegerForLoop (spFor, spTo, id, start: SynExpr, dir, finish: SynExpr, innerExpr, m: range) =
     let mOp = (unionRanges start.Range finish.Range).MakeSynthetic()
@@ -179,7 +181,7 @@ let YieldFree (cenv: cenv) expr =
 /// Determine if a syntactic expression inside 'seq { ... }' or '[...]' counts as a "simple sequence
 /// of semicolon separated values". For example [1;2;3].
 /// 'acceptDeprecated' is true for the '[ ... ]' case, where we allow the syntax '[ if g then t else e ]' but ask it to be parenthesized
-///
+[<return: Struct>]
 let (|SimpleSemicolonSequence|_|) cenv acceptDeprecated cexpr =
 
     let IsSimpleSemicolonSequenceElement expr =
@@ -207,12 +209,12 @@ let (|SimpleSemicolonSequence|_|) cenv acceptDeprecated cexpr =
             if IsSimpleSemicolonSequenceElement e1 then
                 TryGetSimpleSemicolonSequenceOfComprehension e2 (e1 :: acc)
             else
-                None
+                ValueNone
         | _ ->
             if IsSimpleSemicolonSequenceElement expr then
-                Some(List.rev (expr :: acc))
+                ValueSome(List.rev (expr :: acc))
             else
-                None
+                ValueNone
 
     TryGetSimpleSemicolonSequenceOfComprehension cexpr []
 

src/Compiler/Checking/CheckExpressions.fs

@@ -3115,15 +3115,17 @@ let BuildRecdFieldSet g m objExpr (rfinfo: RecdFieldInfo) argExpr =
 // Helpers dealing with named and optional args at callsites
 //-------------------------------------------------------------------------
 
+[<return: Struct>]
 let (|BinOpExpr|_|) expr =
     match expr with
-    | SynExpr.App (_, _, SynExpr.App (_, _, SingleIdent opId, a, _), b, _) -> Some (opId, a, b)
-    | _ -> None
+    | SynExpr.App (_, _, SynExpr.App (_, _, SingleIdent opId, a, _), b, _) -> ValueSome (opId, a, b)
+    | _ -> ValueNone
 
+[<return: Struct>]
 let (|SimpleEqualsExpr|_|) expr =
     match expr with
-    | BinOpExpr(opId, a, b) when opId.idText = opNameEquals -> Some (a, b)
-    | _ -> None
+    | BinOpExpr(opId, a, b) when opId.idText = opNameEquals -> ValueSome (a, b)
+    | _ -> ValueNone
 
 /// Detect a named argument at a callsite
 let TryGetNamedArg expr =

src/Compiler/Checking/CheckExpressions.fsi

@@ -712,7 +712,8 @@ val TcMatchPattern:
     synWhenExprOpt: SynExpr option ->
         Pattern * Expr option * Val list * TcEnv * UnscopedTyparEnv
 
-val (|BinOpExpr|_|): SynExpr -> (Ident * SynExpr * SynExpr) option
+[<return: Struct>]
+val (|BinOpExpr|_|): SynExpr -> (Ident * SynExpr * SynExpr) voption
 
 /// Check a set of let bindings in a class or module
 val TcLetBindings:

src/Compiler/Checking/NameResolution.fs

@@ -1739,87 +1739,100 @@ let (|ValRefOfProp|_|) (pi: PropInfo) = pi.ArbitraryValRef
 let (|ValRefOfMeth|_|) (mi: MethInfo) = mi.ArbitraryValRef
 let (|ValRefOfEvent|_|) (evt: EventInfo) = evt.ArbitraryValRef
 
+[<return: Struct>]
 let rec (|RecordFieldUse|_|) (item: Item) =
     match item with
-    | Item.RecdField(RecdFieldInfo(_, RecdFieldRef(tcref, name))) -> Some (name, tcref)
-    | Item.SetterArg(_, RecordFieldUse f) -> Some f
-    | _ -> None
+    | Item.RecdField(RecdFieldInfo(_, RecdFieldRef(tcref, name))) -> ValueSome (name, tcref)
+    | Item.SetterArg(_, RecordFieldUse f) -> ValueSome f
+    | _ -> ValueNone
 
+[<return: Struct>]
 let (|UnionCaseFieldUse|_|) (item: Item) =
     match item with
-    | Item.UnionCaseField (uci, fieldIndex) -> Some (fieldIndex, uci.UnionCaseRef)
-    | _ -> None
+    | Item.UnionCaseField (uci, fieldIndex) -> ValueSome (fieldIndex, uci.UnionCaseRef)
+    | _ -> ValueNone
 
+[<return: Struct>]
 let rec (|ILFieldUse|_|) (item: Item) =
     match item with
-    | Item.ILField finfo -> Some finfo
-    | Item.SetterArg(_, ILFieldUse f) -> Some f
-    | _ -> None
+    | Item.ILField finfo -> ValueSome finfo
+    | Item.SetterArg(_, ILFieldUse f) -> ValueSome f
+    | _ -> ValueNone
 
+[<return: Struct>]
 let rec (|PropertyUse|_|) (item: Item) =
     match item with
-    | Item.Property(info = pinfo :: _) -> Some pinfo
-    | Item.SetterArg(_, PropertyUse pinfo) -> Some pinfo
-    | _ -> None
+    | Item.Property(info = pinfo :: _) -> ValueSome pinfo
+    | Item.SetterArg(_, PropertyUse pinfo) -> ValueSome pinfo
+    | _ -> ValueNone
 
+[<return: Struct>]
 let rec (|FSharpPropertyUse|_|) (item: Item) =
     match item with
-    | Item.Property(info = [ValRefOfProp vref]) -> Some vref
-    | Item.SetterArg(_, FSharpPropertyUse propDef) -> Some propDef
-    | _ -> None
+    | Item.Property(info = [ValRefOfProp vref]) -> ValueSome vref
+    | Item.SetterArg(_, FSharpPropertyUse propDef) -> ValueSome propDef
+    | _ -> ValueNone
 
+[<return: Struct>]
 let (|MethodUse|_|) (item: Item) =
     match item with
-    | Item.MethodGroup(_, [minfo], _) -> Some minfo
-    | _ -> None
+    | Item.MethodGroup(_, [minfo], _) -> ValueSome minfo
+    | _ -> ValueNone
 
+[<return: Struct>]
 let (|FSharpMethodUse|_|) (item: Item) =
     match item with
-    | Item.MethodGroup(_, [ValRefOfMeth vref], _) -> Some vref
-    | Item.Value vref when vref.IsMember -> Some vref
-    | _ -> None
+    | Item.MethodGroup(_, [ValRefOfMeth vref], _) -> ValueSome vref
+    | Item.Value vref when vref.IsMember -> ValueSome vref
+    | _ -> ValueNone
 
+[<return: Struct>]
 let (|EntityUse|_|) (item: Item) =
     match item with
-    | Item.UnqualifiedType (tcref :: _) -> Some tcref
-    | Item.ExnCase tcref -> Some tcref
+    | Item.UnqualifiedType (tcref :: _) -> ValueSome tcref
+    | Item.ExnCase tcref -> ValueSome tcref
     | Item.Types(_, [AbbrevOrAppTy tcref])
-    | Item.DelegateCtor(AbbrevOrAppTy tcref) -> Some tcref
+    | Item.DelegateCtor(AbbrevOrAppTy tcref) -> ValueSome tcref
     | Item.CtorGroup(_, ctor :: _) ->
         match ctor.ApparentEnclosingType with
-        | AbbrevOrAppTy tcref -> Some tcref
-        | _ -> None
-    | _ -> None
+        | AbbrevOrAppTy tcref -> ValueSome tcref
+        | _ -> ValueNone
+    | _ -> ValueNone
 
+[<return: Struct>]
 let (|EventUse|_|) (item: Item) =
     match item with
-    | Item.Event einfo -> Some einfo
-    | _ -> None
+    | Item.Event einfo -> ValueSome einfo
+    | _ -> ValueNone
 
+[<return: Struct>]
 let (|FSharpEventUse|_|) (item: Item) =
     match item with
-    | Item.Event(ValRefOfEvent vref) -> Some vref
-    | _ -> None
+    | Item.Event(ValRefOfEvent vref) -> ValueSome vref
+    | _ -> ValueNone
 
+[<return: Struct>]
 let (|UnionCaseUse|_|) (item: Item) =
     match item with
-    | Item.UnionCase(UnionCaseInfo(_, u1), _) -> Some u1
-    | _ -> None
+    | Item.UnionCase(UnionCaseInfo(_, u1), _) -> ValueSome u1
+    | _ -> ValueNone
 
+[<return: Struct>]
 let (|ValUse|_|) (item: Item) =
     match item with
     | Item.Value vref
     | FSharpPropertyUse vref
     | FSharpMethodUse vref
     | FSharpEventUse vref
-    | Item.CustomBuilder(_, vref) -> Some vref
-    | _ -> None
+    | Item.CustomBuilder(_, vref) -> ValueSome vref
+    | _ -> ValueNone
 
+[<return: Struct>]
 let (|ActivePatternCaseUse|_|) (item: Item) =
     match item with
-    | Item.ActivePatternCase(APElemRef(_, vref, idx, _)) -> Some (vref.SigRange, vref.DefinitionRange, idx)
-    | Item.ActivePatternResult(ap, _, idx, _) -> Some (ap.Range, ap.Range, idx)
-    | _ -> None
+    | Item.ActivePatternCase(APElemRef(_, vref, idx, _)) -> ValueSome (vref.SigRange, vref.DefinitionRange, idx)
+    | Item.ActivePatternResult(ap, _, idx, _) -> ValueSome (ap.Range, ap.Range, idx)
+    | _ -> ValueNone
 
 let tyconRefDefnHash (_g: TcGlobals) (eref1: EntityRef) =
     hash eref1.LogicalName
@@ -2840,9 +2853,10 @@ let private ResolveLongIdentInTyconRefs atMostOne (ncenv: NameResolver) nenv loo
 // ResolveExprLongIdentInModuleOrNamespace
 //-------------------------------------------------------------------------
 
+[<return: Struct>]
 let (|AccessibleEntityRef|_|) amap m ad (modref: ModuleOrNamespaceRef) mspec =
     let eref = modref.NestedTyconRef mspec
-    if IsEntityAccessible amap m ad eref then Some eref else None
+    if IsEntityAccessible amap m ad eref then ValueSome eref else ValueNone
 
 let rec ResolveExprLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv (typeNameResInfo: TypeNameResolutionInfo) ad resInfo depth m modref (mty: ModuleOrNamespaceType) (id: Ident) (rest: Ident list) =
     // resInfo records the modules or namespaces actually relevant to a resolution
@@ -4088,11 +4102,12 @@ let ResolveLongIdentAsExprAndComputeRange (sink: TcResultsSink) (ncenv: NameReso
 
     success (tinstEnclosing, item, itemRange, rest, afterResolution)
 
+[<return: Struct>]
 let (|NonOverridable|_|) namedItem =
     match namedItem with
-    |   Item.MethodGroup(_, minfos, _) when minfos |> List.exists(fun minfo -> minfo.IsVirtual || minfo.IsAbstract) -> None
-    |   Item.Property(info = pinfos) when pinfos |> List.exists(fun pinfo -> pinfo.IsVirtualProperty) -> None
-    |   _ -> Some ()
+    |   Item.MethodGroup(_, minfos, _) when minfos |> List.exists(fun minfo -> minfo.IsVirtual || minfo.IsAbstract) -> ValueNone
+    |   Item.Property(info = pinfos) when pinfos |> List.exists(fun pinfo -> pinfo.IsVirtualProperty) -> ValueNone
+    |   _ -> ValueSome ()
 
 /// Called for 'expression.Bar' - for VS IntelliSense, we can filter out static members from method groups
 /// Also called for 'GenericType<Args>.Bar' - for VS IntelliSense, we can filter out non-static members from method groups

src/Compiler/Checking/PatternMatchCompilation.fs

@@ -740,19 +740,22 @@ let ChooseInvestigationPointLeftToRight frontiers =
 // This is an initial attempt to remove extra typetests/castclass for simple list pattern matching "match x with h :: t -> ... | [] -> ..."
 // The problem with this technique is that it creates extra locals which inhibit the process of converting pattern matches into linear let bindings.
 
+[<return: Struct>]
 let (|ListConsDiscrim|_|) g = function
      | (DecisionTreeTest.UnionCase (ucref, tinst))
                 (* check we can use a simple 'isinst' instruction *)
-                when tyconRefEq g ucref.TyconRef g.list_tcr_canon & ucref.CaseName = "op_ColonColon" -> Some tinst
-     | _ -> None
+                when tyconRefEq g ucref.TyconRef g.list_tcr_canon & ucref.CaseName = "op_ColonColon" -> ValueSome tinst
+     | _ -> ValueNone
 
+[<return: Struct>]
 let (|ListEmptyDiscrim|_|) g = function
      | (DecisionTreeTest.UnionCase (ucref, tinst))
                 (* check we can use a simple 'isinst' instruction *)
-                when tyconRefEq g ucref.TyconRef g.list_tcr_canon & ucref.CaseName = "op_Nil" -> Some tinst
-     | _ -> None
+                when tyconRefEq g ucref.TyconRef g.list_tcr_canon & ucref.CaseName = "op_Nil" -> ValueSome tinst
+     | _ -> ValueNone
 #endif
 
+[<return: Struct>]
 let (|ConstNeedsDefaultCase|_|) c =
     match c with
     | Const.Decimal _
@@ -767,8 +770,8 @@ let (|ConstNeedsDefaultCase|_|) c =
     | Const.UInt64 _
     | Const.IntPtr _
     | Const.UIntPtr _
-    | Const.Char _ -> Some ()
-    | _ -> None
+    | Const.Char _ -> ValueSome ()
+    | _ -> ValueNone
 
 /// Build a dtree, equivalent to: TDSwitch("expr", edges, default, m)
 ///

src/Compiler/Checking/QuotationTranslator.fs

@@ -167,33 +167,37 @@ exception IgnoringPartOfQuotedTermWarning of string * range
 
 let wfail e = raise (InvalidQuotedTerm e)
 
+[<return: Struct>]
 let (|ModuleValueOrMemberUse|_|) g expr =
     let rec loop expr args =
         match stripExpr expr with
         | Expr.App (InnerExprPat(Expr.Val (vref, vFlags, _) as f), fty, tyargs, actualArgs, _m) when vref.IsMemberOrModuleBinding ->
-            Some(vref, vFlags, f, fty, tyargs, actualArgs @ args)
+            ValueSome(vref, vFlags, f, fty, tyargs, actualArgs @ args)
         | Expr.App (f, _fTy, [], actualArgs, _) ->
             loop f (actualArgs @ args)
         | Expr.Val (vref, vFlags, _m) as f when (match vref.TryDeclaringEntity with ParentNone -> false | _ -> true) ->
             let fty = tyOfExpr g f
-            Some(vref, vFlags, f, fty, [], args)
+            ValueSome(vref, vFlags, f, fty, [], args)
         | _ ->
-            None
+            ValueNone
     loop expr []
 
+[<return: Struct>]
 let (|SimpleArrayLoopUpperBound|_|) expr =
     match expr with
-    | Expr.Op (TOp.ILAsm ([AI_sub], _), _, [Expr.Op (TOp.ILAsm ([I_ldlen; AI_conv ILBasicType.DT_I4], _), _, _, _); Expr.Const (Const.Int32 1, _, _) ], _) -> Some ()
-    | _ -> None
+    | Expr.Op (TOp.ILAsm ([AI_sub], _), _, [Expr.Op (TOp.ILAsm ([I_ldlen; AI_conv ILBasicType.DT_I4], _), _, _, _); Expr.Const (Const.Int32 1, _, _) ], _) -> ValueSome ()
+    | _ -> ValueNone
 
+[<return: Struct>]
 let (|SimpleArrayLoopBody|_|) g expr =
     match expr with
     | Expr.Lambda (_, a, b, ([_] as args), DebugPoints (Expr.Let (TBind(forVarLoop, DebugPoints (Expr.Op (TOp.ILAsm ([I_ldelem_any(ILArrayShape [(Some 0, None)], _)], _), [elemTy], [arr; idx], m1), _), seqPoint), body, m2, freeVars), _), m, ty) ->
         let body = Expr.Let (TBind(forVarLoop, mkCallArrayGet g m1 elemTy arr idx, seqPoint), body, m2, freeVars)
         let expr = Expr.Lambda (newUnique(), a, b, args, body, m, ty)
-        Some (arr, elemTy, expr)
-    | _ -> None
+        ValueSome (arr, elemTy, expr)
+    | _ -> ValueNone
 
+[<return: Struct>]
 let (|ObjectInitializationCheck|_|) g expr =
     // recognize "if this.init@ < 1 then failinit"
     match expr with
@@ -207,8 +211,8 @@ let (|ObjectInitializationCheck|_|) g expr =
             name.StartsWithOrdinal("init") &&
             selfRef.IsMemberThisVal &&
             valRefEq g failInitRef (ValRefForIntrinsic g.fail_init_info) &&
-            isUnitTy g resultTy -> Some()
-    | _ -> None
+            isUnitTy g resultTy -> ValueSome()
+    | _ -> ValueNone
 
 let isSplice g vref = valRefEq g vref g.splice_expr_vref || valRefEq g vref g.splice_raw_expr_vref