Don't recompute UnionCaseInfo attributes

src/Argu/PreCompute.fs

@@ -9,6 +9,23 @@ open System.Text.RegularExpressions
 
 open FSharp.Reflection
 
+[<AutoOpen>]
+module private FastAttributes =
+    let inline hasAttribute<'T when 'T :> Attribute> (attributes: obj[]) =
+        attributes |> Array.tryFindIndex (fun x -> x :? 'T) <> None
+
+    let inline hasAttribute2<'T when 'T :> Attribute> (attributes1: obj[]) (attributes2: Attribute[]) =
+        (hasAttribute<'T> attributes1) || (attributes2 |> Array.tryFindIndex (fun x -> x :? 'T) <> None)
+
+    let inline tryGetAttribute<'T when 'T :> Attribute> (attributes: obj[]) =
+        attributes |> Array.tryFind (fun x -> x :? 'T) |> Option.map (fun x -> x :?> 'T)
+
+    let inline tryGetAttribute2<'T when 'T :> Attribute> (attributes: obj[]) (attributes2: Attribute[]) =
+        match tryGetAttribute<'T> attributes with
+        | Some _ as attr -> attr
+        | None ->
+            attributes2 |> Array.tryFind (fun x -> x :? 'T) |> Option.map (fun x -> x :?> 'T)
+
 let defaultHelpParam = "help"
 let defaultHelpDescription = "display this list of options."
 
@@ -21,9 +38,9 @@ let getDefaultHelpParam (t : Type) =
     prefixString + defaultHelpParam
 
 /// construct a CLI param from UCI name
-let generateOptionName (uci : UnionCaseInfo) =
+let generateOptionName (uci : UnionCaseInfo) (attributes1: obj[]) (attributes2: Attribute[])=
     let prefixString =
-        match uci.TryGetAttribute<CliPrefixAttribute>(true) with
+        match tryGetAttribute2<CliPrefixAttribute> attributes1 attributes2 with
         | None -> CliPrefix.DoubleDash
         | Some pf -> pf.Prefix
 
@@ -133,7 +150,7 @@ let tryGetDuEnumerationParser label (t : Type) =
     let tagReader = lazy(FSharpValue.PreComputeUnionTagReader(t, allBindings))
     let extractUciInfo (uci : UnionCaseInfo) =
         let name =
-            match uci.TryGetAttribute<CustomCommandLineAttribute>() with
+            match tryGetAttribute<CustomCommandLineAttribute> (uci.GetCustomAttributes()) with
             | None -> generateEnumName uci.Name
             | Some attr -> attr.Name
 
@@ -280,18 +297,21 @@ let rec private preComputeUnionCaseArgInfo (stack : Type list) (helpParam : Help
     let current = ref None
     let tryGetCurrent = fun () -> !current
 
-    let isNoCommandLine = lazy(uci.ContainsAttribute<NoCommandLineAttribute> (true))
-    let isAppSettingsCSV = lazy(uci.ContainsAttribute<ParseCSVAttribute> ())
-    let isExactlyOnce = lazy(uci.ContainsAttribute<ExactlyOnceAttribute> (true))
-    let isMandatory = lazy(isExactlyOnce.Value || uci.ContainsAttribute<MandatoryAttribute> (true))
-    let isUnique = lazy(isExactlyOnce.Value || uci.ContainsAttribute<UniqueAttribute> (true))
-    let isInherited = lazy(uci.ContainsAttribute<InheritAttribute> ())
-    let isGatherAll = lazy(uci.ContainsAttribute<GatherAllSourcesAttribute> ())
-    let isRest = lazy(uci.ContainsAttribute<RestAttribute> ())
-    let isHidden = lazy(uci.ContainsAttribute<HiddenAttribute> ())
+    let attributes = lazy(uci.GetCustomAttributes())
+    let declaringTypeAttributes = lazy(uci.DeclaringType.GetCustomAttributes() |> Array.ofSeq)
+
+    let isNoCommandLine = lazy(hasAttribute2<NoCommandLineAttribute> attributes.Value declaringTypeAttributes.Value)
+    let isAppSettingsCSV = lazy(hasAttribute<ParseCSVAttribute> attributes.Value)
+    let isExactlyOnce = lazy(hasAttribute2<ExactlyOnceAttribute> attributes.Value declaringTypeAttributes.Value)
+    let isMandatory = lazy(isExactlyOnce.Value || hasAttribute2<MandatoryAttribute> attributes.Value declaringTypeAttributes.Value)
+    let isUnique = lazy(isExactlyOnce.Value || hasAttribute2<UniqueAttribute> attributes.Value declaringTypeAttributes.Value)
+    let isInherited = lazy(hasAttribute<InheritAttribute> attributes.Value)
+    let isGatherAll = lazy(hasAttribute<GatherAllSourcesAttribute> attributes.Value)
+    let isRest = lazy(hasAttribute<RestAttribute> attributes.Value)
+    let isHidden = lazy(hasAttribute<HiddenAttribute> attributes.Value)
 
     let mainCommandName = lazy(
-        match uci.TryGetAttribute<MainCommandAttribute> () with
+        match tryGetAttribute<MainCommandAttribute> attributes.Value with
         | None -> None
         | Some _ when isNoCommandLine.Value -> arguExn "parameter '%O' contains conflicting attributes 'MainCommand' and 'NoCommandLine'." uci
         | Some _ when types.Length = 0 -> arguExn "parameter '%O' contains MainCommand attribute but has unsupported arity 0." uci
@@ -304,7 +324,7 @@ let rec private preComputeUnionCaseArgInfo (stack : Type list) (helpParam : Help
     let isMainCommand = lazy(Option.isSome mainCommandName.Value)
 
     let cliPosition = lazy(
-        match uci.TryGetAttribute<CliPositionAttribute> () with
+        match tryGetAttribute<CliPositionAttribute> attributes.Value with
         | Some attr ->
             match attr.Position with
             | CliPosition.Unspecified
@@ -314,7 +334,7 @@ let rec private preComputeUnionCaseArgInfo (stack : Type list) (helpParam : Help
         | None -> CliPosition.Unspecified)
 
     let customAssignmentSeparator = lazy(
-        match uci.TryGetAttribute<CustomAssignmentAttribute> (true) with
+        match tryGetAttribute2<CustomAssignmentAttribute> attributes.Value declaringTypeAttributes.Value with
         | Some attr ->
             if isMainCommand.Value && types.Length = 1 then
                 arguExn "parameter '%O' of arity 1 contains incompatible attributes 'CustomAssignment' and 'MainCommand'." uci
@@ -329,7 +349,7 @@ let rec private preComputeUnionCaseArgInfo (stack : Type list) (helpParam : Help
         | None -> None)
 
     let isGatherUnrecognized = lazy(
-        if uci.ContainsAttribute<GatherUnrecognizedAttribute>() then
+        if hasAttribute<GatherUnrecognizedAttribute> attributes.Value then
             match types with
             | _ when isMainCommand.Value -> arguExn "parameter '%O' contains incompatible combination of attributes 'MainCommand' and 'GatherUnrecognized'." uci
             | [|t|] when t = typeof<string> -> true
@@ -338,7 +358,7 @@ let rec private preComputeUnionCaseArgInfo (stack : Type list) (helpParam : Help
             false)
 
     let appSettingsSeparators, appSettingsSplitOptions =
-        match uci.TryGetAttribute<AppSettingsSeparatorAttribute> (true) with
+        match tryGetAttribute2<AppSettingsSeparatorAttribute> attributes.Value declaringTypeAttributes.Value with
         | None -> [|","|], StringSplitOptions.None
         | Some attr when attr.Separators.Length = 0 ->
             arguExn "parameter '%O' specifies a null or empty AppSettings separator." uci
@@ -408,23 +428,24 @@ let rec private preComputeUnionCaseArgInfo (stack : Type list) (helpParam : Help
         if isMainCommand.Value || isNoCommandLine.Value then []
         else
             let cliNames = [
-                match uci.TryGetAttribute<CustomCommandLineAttribute> () with
-                | None -> yield generateOptionName uci
+                match tryGetAttribute<CustomCommandLineAttribute> attributes.Value with
+                | None -> yield generateOptionName uci attributes.Value declaringTypeAttributes.Value
                 | Some attr -> yield attr.Name ; yield! attr.AltNames
 
                 yield!
-                    uci.GetAttributes<AltCommandLineAttribute>()
-                    |> Seq.collect (fun attr -> attr.Names)
+                    attributes.Value
+                    |> Array.filter (fun x -> x :? AltCommandLineAttribute)
+                    |> Array.collect(fun x -> (x :?> AltCommandLineAttribute).Names)
             ]
 
             for name in cliNames do validateCliParam name
 
             cliNames)
 
     let appSettingsName = lazy(
-        if uci.ContainsAttribute<NoAppSettingsAttribute> (true) then None
+        if hasAttribute2<NoAppSettingsAttribute> attributes.Value declaringTypeAttributes.Value then None
         else
-            match uci.TryGetAttribute<CustomAppSettingsAttribute> () with
+            match tryGetAttribute<CustomAppSettingsAttribute> attributes.Value with
             | None -> Some <| generateAppSettingsName uci
             | Some _ when parsers.Value.Type = ArgumentType.SubCommand -> arguExn "CustomAppSettings in %O not supported in subcommands." uci
             | Some attr when not <| String.IsNullOrWhiteSpace attr.Name -> Some attr.Name

src/Argu/Utils.fs

@@ -137,40 +137,6 @@ type IDictionary<'K,'V> with
 
 let currentProgramName = lazy(System.Diagnostics.Process.GetCurrentProcess().MainModule.ModuleName)
 
-type UnionCaseInfo with
-    member uci.GetAttributes<'T when 'T :> Attribute> (?includeDeclaringTypeAttrs : bool) =
-        let includeDeclaringTypeAttrs = defaultArg includeDeclaringTypeAttrs false
-
-        let caseAttrs = uci.GetCustomAttributes typeof<'T> |> Seq.cast<Attribute>
-        let attrs =
-            if includeDeclaringTypeAttrs then
-                uci.DeclaringType.GetCustomAttributes(typeof<'T>, false)
-                |> Seq.cast<Attribute>
-                |> Seq.append caseAttrs
-            else
-                caseAttrs
-
-        attrs |> Seq.map (fun o -> o :?> 'T)
-
-    member uci.TryGetAttribute<'T when 'T :> Attribute> (?includeDeclaringTypeAttrs : bool) =
-        let includeDeclaringTypeAttrs = defaultArg includeDeclaringTypeAttrs false
-
-        match uci.GetCustomAttributes typeof<'T> with
-        | [||] when includeDeclaringTypeAttrs ->
-            match uci.DeclaringType.GetCustomAttributes(typeof<'T>, false) |> Seq.toArray with
-            | [||] -> None
-            | attrs -> Some (attrs.[0] :?> 'T)
-        | [||] -> None
-        | attrs -> Some (attrs.[0] :?> 'T)
-
-    member uci.ContainsAttribute<'T when 'T :> Attribute> (?includeDeclaringTypeAttrs : bool) =
-        let includeDeclaringTypeAttrs = defaultArg includeDeclaringTypeAttrs false
-        if uci.GetCustomAttributes typeof<'T> |> Array.isEmpty |> not then true
-        elif includeDeclaringTypeAttrs then
-            uci.DeclaringType.GetCustomAttributes(typeof<'T>, false) |> Seq.isEmpty |> not
-        else
-            false
-
 /// recognize exprs that strictly contain DU constructors
 /// e.g. <@ Case @> is valid but <@ fun x y -> Case y x @> is invalid
 let expr2Uci (e : Expr) =