More ValueOption in compiler: part 3 (and the last)

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

@@ -20,3 +20,4 @@
 ### Changed
 
 * Improve error of Active Pattern case Argument Count Not Match ([PR #16846](https://github.com/dotnet/fsharp/pull/16846))
+* Reduce allocations in compiler checking via `ValueOption` usage ([PR #16822](https://github.com/dotnet/fsharp/pull/16822))

src/Compiler/Driver/CompilerDiagnostics.fs

@@ -616,10 +616,11 @@ module OldStyleMessages =
 let mutable showParserStackOnParseError = false
 #endif
 
+[<return: Struct>]
 let (|InvalidArgument|_|) (exn: exn) =
     match exn with
-    | :? ArgumentException as e -> Some e.Message
-    | _ -> None
+    | :? ArgumentException as e -> ValueSome e.Message
+    | _ -> ValueNone
 
 let OutputNameSuggestions (os: StringBuilder) suggestNames suggestionsF idText =
     if suggestNames then

src/Compiler/Driver/CreateILModule.fs

@@ -54,11 +54,12 @@ module AttributeHelpers =
             | Some(Attrib(_, _, [ AttribBoolArg p ], _, _, _, _)) -> Some p
             | _ -> None
 
+    [<return: Struct>]
     let (|ILVersion|_|) (versionString: string) =
         try
-            Some(parseILVersion versionString)
+            ValueSome(parseILVersion versionString)
         with e ->
-            None
+            ValueNone
 
 //----------------------------------------------------------------------------
 // ValidateKeySigningAttributes, GetStrongNameSigner

src/Compiler/Driver/GraphChecking/FileContentMapping.fs

@@ -330,7 +330,8 @@ let visitNameofResult (nameofResult: NameofResult) : FileContentEntry =
         FileContentEntry.PrefixedIdentifier(longIdentToPath false longIdent)
 
 /// Special case of `nameof Module` type of expression
-let (|NameofExpr|_|) (e: SynExpr) : NameofResult option =
+[<return: Struct>]
+let (|NameofExpr|_|) (e: SynExpr) : NameofResult voption =
     let rec stripParen (e: SynExpr) =
         match e with
         | SynExpr.Paren(expr = expr) -> stripParen expr
@@ -339,15 +340,15 @@ let (|NameofExpr|_|) (e: SynExpr) : NameofResult option =
     match e with
     | SynExpr.App(flag = ExprAtomicFlag.NonAtomic; isInfix = false; funcExpr = SynExpr.Ident NameofIdent; argExpr = moduleNameExpr) ->
         match stripParen moduleNameExpr with
-        | SynExpr.Ident moduleNameIdent -> Some(NameofResult.SingleIdent moduleNameIdent)
+        | SynExpr.Ident moduleNameIdent -> ValueSome(NameofResult.SingleIdent moduleNameIdent)
         | SynExpr.LongIdent(longDotId = longIdent) ->
             match longIdent.LongIdent with
-            | [] -> None
+            | [] -> ValueNone
             // This is highly unlikely to be produced by the parser
-            | [ moduleNameIdent ] -> Some(NameofResult.SingleIdent moduleNameIdent)
-            | lid -> Some(NameofResult.LongIdent(lid))
-        | _ -> None
-    | _ -> None
+            | [ moduleNameIdent ] -> ValueSome(NameofResult.SingleIdent moduleNameIdent)
+            | lid -> ValueSome(NameofResult.LongIdent(lid))
+        | _ -> ValueNone
+    | _ -> ValueNone
 
 let visitSynExpr (e: SynExpr) : FileContentEntry list =
     let rec visit (e: SynExpr) (continuation: FileContentEntry list -> FileContentEntry list) : FileContentEntry list =
@@ -566,6 +567,7 @@ let visitSynExpr (e: SynExpr) : FileContentEntry list =
     visit e id
 
 /// Special case of `| nameof Module ->` type of pattern
+[<return: Struct>]
 let (|NameofPat|_|) (pat: SynPat) =
     let rec stripPats p =
         match p with
@@ -582,11 +584,11 @@ let (|NameofPat|_|) (pat: SynPat) =
             argPats = SynArgPats.Pats []
             accessibility = None) ->
             match longIdent with
-            | [] -> None
-            | [ moduleNameIdent ] -> Some(NameofResult.SingleIdent moduleNameIdent)
-            | lid -> Some(NameofResult.LongIdent lid)
-        | _ -> None
-    | _ -> None
+            | [] -> ValueNone
+            | [ moduleNameIdent ] -> ValueSome(NameofResult.SingleIdent moduleNameIdent)
+            | lid -> ValueSome(NameofResult.LongIdent lid)
+        | _ -> ValueNone
+    | _ -> ValueNone
 
 let visitPat (p: SynPat) : FileContentEntry list =
     let rec visit (p: SynPat) (continuation: FileContentEntry list -> FileContentEntry list) : FileContentEntry list =

src/Compiler/Facilities/AsyncMemoize.fs

@@ -30,15 +30,16 @@ module internal Utils =
 
     let replayDiagnostics (logger: DiagnosticsLogger) = Seq.iter ((<|) logger.DiagnosticSink)
 
+    [<return: Struct>]
     let (|TaskCancelled|_|) (ex: exn) =
         match ex with
-        | :? System.Threading.Tasks.TaskCanceledException as tce -> Some tce
+        | :? System.Threading.Tasks.TaskCanceledException as tce -> ValueSome tce
         //| :? System.AggregateException as ae ->
         //    if ae.InnerExceptions |> Seq.forall (fun e -> e :? System.Threading.Tasks.TaskCanceledException) then
         //        ae.InnerExceptions |> Seq.tryHead |> Option.map (fun e -> e :?> System.Threading.Tasks.TaskCanceledException)
         //    else
         //        None
-        | _ -> None
+        | _ -> ValueNone
 
 type internal StateUpdate<'TValue> =
     | CancelRequest

src/Compiler/Facilities/AsyncMemoize.fsi

@@ -9,7 +9,8 @@ module internal Utils =
     /// Return file name with one directory above it
     val shortPath: path: string -> string
 
-    val (|TaskCancelled|_|): ex: exn -> TaskCanceledException option
+    [<return: Struct>]
+    val (|TaskCancelled|_|): ex: exn -> TaskCanceledException voption
 
 type internal JobEvent =
     | Requested

src/Compiler/Facilities/DiagnosticsLogger.fs

@@ -69,10 +69,11 @@ exception StopProcessingExn of exn option with
         | StopProcessingExn(Some exn) -> "StopProcessingExn, originally (" + exn.ToString() + ")"
         | _ -> "StopProcessingExn"
 
+[<return: Struct>]
 let (|StopProcessing|_|) exn =
     match exn with
-    | StopProcessingExn _ -> Some()
-    | _ -> None
+    | StopProcessingExn _ -> ValueSome()
+    | _ -> ValueNone
 
 let StopProcessing<'T> = StopProcessingExn None
 

src/Compiler/Facilities/DiagnosticsLogger.fsi

@@ -39,7 +39,8 @@ val NoSuggestions: Suggestions
 /// Thrown when we stop processing the F# Interactive entry or #load.
 exception StopProcessingExn of exn option
 
-val (|StopProcessing|_|): exn: exn -> unit option
+[<return: Struct>]
+val (|StopProcessing|_|): exn: exn -> unit voption
 
 val StopProcessing<'T> : exn
 

src/Compiler/Symbols/SymbolHelpers.fs

@@ -356,12 +356,13 @@ module internal SymbolHelpers =
         [ for tp, ty in prettyTyparInst -> 
             wordL (tagTypeParameter ("'" + tp.DisplayName))  ^^ wordL (tagText (FSComp.SR.descriptionWordIs())) ^^ NicePrint.layoutType denv ty  ]
 
+    [<return: Struct>]
     let (|ItemWhereTypIsPreferred|_|) item = 
         match item with 
         | Item.DelegateCtor ty
         | Item.CtorGroup(_, [DefaultStructCtor(_, ty)])
-        | Item.Types(_, [ty])  -> Some ty
-        | _ -> None
+        | Item.Types(_, [ty])  -> ValueSome ty
+        | _ -> ValueNone
 
     /// Specifies functions for comparing 'Item' objects with respect to the user 
     /// (this means that some values that are not technically equal are treated as equal 
@@ -730,19 +731,21 @@ module internal SymbolHelpers =
 #if !NO_TYPEPROVIDERS
 
     /// Determine if an item is a provided type 
+    [<return: Struct>]
     let (|ItemIsProvidedType|_|) g item =
         match item with
         | Item.Types(_name, tys) ->
             match tys with
             | [AppTy g (tcref, _typeInst)] ->
                 if tcref.IsProvidedErasedTycon || tcref.IsProvidedGeneratedTycon then
-                    Some tcref
+                    ValueSome tcref
                 else
-                    None
-            | _ -> None
-        | _ -> None
+                    ValueNone
+            | _ -> ValueNone
+        | _ -> ValueNone
 
     /// Determine if an item is a provided type that has static parameters
+    [<return: Struct>]
     let (|ItemIsProvidedTypeWithStaticArguments|_|) m g item =
         match item with
         | Item.Types(_name, tys) ->
@@ -755,31 +758,33 @@ module internal SymbolHelpers =
                         | _ -> failwith "unreachable"
                     let staticParameters = typeBeforeArguments.PApplyWithProvider((fun (typeBeforeArguments, provider) -> typeBeforeArguments.GetStaticParameters provider), range=m) 
                     let staticParameters = staticParameters.PApplyArray(id, "GetStaticParameters", m)
-                    Some staticParameters
+                    ValueSome staticParameters
                 else
-                    None
-            | _ -> None
-        | _ -> None
+                    ValueNone
+            | _ -> ValueNone
+        | _ -> ValueNone
 
+    [<return: Struct>]
     let (|ItemIsProvidedMethodWithStaticArguments|_|) item =
         match item with
         // Prefer the static parameters from the uninstantiated method info
         | Item.MethodGroup(_, _, Some minfo) ->
             match minfo.ProvidedStaticParameterInfo  with 
-            | Some (_, staticParameters) -> Some staticParameters
-            | _ -> None
+            | Some (_, staticParameters) -> ValueSome staticParameters
+            | _ -> ValueNone
         | Item.MethodGroup(_, [minfo], _) ->
             match minfo.ProvidedStaticParameterInfo  with 
-            | Some (_, staticParameters) -> Some staticParameters
-            | _ -> None
-        | _ -> None
+            | Some (_, staticParameters) -> ValueSome staticParameters
+            | _ -> ValueNone
+        | _ -> ValueNone
 
     /// Determine if an item has static arguments
+    [<return: Struct>]
     let (|ItemIsWithStaticArguments|_|) m g item =
         match item with
-        | ItemIsProvidedTypeWithStaticArguments m g staticParameters -> Some staticParameters
-        | ItemIsProvidedMethodWithStaticArguments staticParameters -> Some staticParameters
-        | _ -> None
+        | ItemIsProvidedTypeWithStaticArguments m g staticParameters -> ValueSome staticParameters
+        | ItemIsProvidedMethodWithStaticArguments staticParameters -> ValueSome staticParameters
+        | _ -> ValueNone
 
 #endif
 

src/Compiler/Symbols/SymbolHelpers.fsi

@@ -59,13 +59,16 @@ module internal SymbolHelpers =
     val SelectMethodGroupItems2: TcGlobals -> range -> ItemWithInst -> ItemWithInst list
 
 #if !NO_TYPEPROVIDERS
-    val (|ItemIsProvidedType|_|): TcGlobals -> Item -> TyconRef option
+    [<return: Struct>]
+    val (|ItemIsProvidedType|_|): TcGlobals -> Item -> TyconRef voption
 
+    [<return: Struct>]
     val (|ItemIsWithStaticArguments|_|):
-        range -> TcGlobals -> Item -> Tainted<TypeProviders.ProvidedParameterInfo>[] option
+        range -> TcGlobals -> Item -> Tainted<TypeProviders.ProvidedParameterInfo>[] voption
 
+    [<return: Struct>]
     val (|ItemIsProvidedTypeWithStaticArguments|_|):
-        range -> TcGlobals -> Item -> Tainted<TypeProviders.ProvidedParameterInfo>[] option
+        range -> TcGlobals -> Item -> Tainted<TypeProviders.ProvidedParameterInfo>[] voption
 #endif
 
     val SimplerDisplayEnv: DisplayEnv -> DisplayEnv

src/Compiler/TypedTree/TypeProviders.fs

@@ -504,8 +504,13 @@ type IProvidedCustomAttributeProvider =
     abstract GetAttributeConstructorArgs: provider: ITypeProvider * attribName: string -> (obj option list * (string * obj option) list) option
 
 type ProvidedCustomAttributeProvider (attributes :ITypeProvider -> seq<CustomAttributeData>) = 
-    let (|Member|_|) (s: string) (x: CustomAttributeNamedArgument) = if x.MemberName = s then Some x.TypedValue else None
-    let (|Arg|_|) (x: CustomAttributeTypedArgument) = match x.Value with null -> None | v -> Some v
+
+    [<return: Struct>]
+    let (|Member|_|) (s: string) (x: CustomAttributeNamedArgument) = if x.MemberName = s then ValueSome x.TypedValue else ValueNone
+
+    [<return: Struct>]
+    let (|Arg|_|) (x: CustomAttributeTypedArgument) = match x.Value with null -> ValueNone | v -> ValueSome v
+
     let findAttribByName tyFullName (a: CustomAttributeData) = (a.Constructor.DeclaringType.FullName = tyFullName)  
     let findAttrib (ty: Type) a = findAttribByName ty.FullName a
     interface IProvidedCustomAttributeProvider with 

src/Compiler/TypedTree/TypedTreeBasics.fs

@@ -256,10 +256,11 @@ let stripTyparEqns ty = stripTyparEqnsAux false ty
 let stripUnitEqns unt = stripUnitEqnsAux false unt
 
 /// Detect a use of a nominal type, including type abbreviations.
+[<return: Struct>]
 let (|AbbrevOrAppTy|_|) (ty: TType) =
     match stripTyparEqns ty with
-    | TType_app (tcref, tinst, _) -> Some(tcref, tinst)
-    | _ -> None
+    | TType_app (tcref, tinst, _) -> ValueSome(tcref, tinst)
+    | _ -> ValueNone
 
 //---------------------------------------------------------------------------
 // These make local/non-local references to values according to whether

src/Compiler/TypedTree/TypedTreeBasics.fsi

@@ -133,7 +133,8 @@ val stripTyparEqns: ty: TType -> TType
 val stripUnitEqns: unt: Measure -> Measure
 
 /// Detect a use of a nominal type, including type abbreviations.
-val (|AbbrevOrAppTy|_|): ty: TType -> (TyconRef * TypeInst) option
+[<return: Struct>]
+val (|AbbrevOrAppTy|_|): ty: TType -> (TyconRef * TypeInst) voption
 
 val mkLocalValRef: v: Val -> ValRef