Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Avoid attributes recomputation #109

Merged
merged 4 commits into from
Mar 12, 2018
Merged

Avoid attributes recomputation #109

Show file tree
Hide file tree
Changes from 2 commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
d599485
Don't recompute UnionCaseInfo attributes
vbfox Mar 11, 2018
82a3189
Remove some printf usages
vbfox Mar 11, 2018
c9d5d4b
Fix review comments
vbfox Mar 12, 2018
35a8a9e
Apply more comments from review
vbfox Mar 12, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
75 changes: 48 additions & 27 deletions src/Argu/PreCompute.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Shouldn't Array.exists suffice here?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ah yes

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

(I need to find a way to remember the name of this method, each time I stay on contains but it's not what I want and I end up rewriting it by other means)


let inline hasAttribute2<'T when 'T :> Attribute> (attributes1: obj[]) (attributes2: Attribute[]) =
(hasAttribute<'T> attributes1) || (attributes2 |> Array.tryFindIndex (fun x -> x :? 'T) <> None)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Same


let inline tryGetAttribute<'T when 'T :> Attribute> (attributes: obj[]) =
attributes |> Array.tryFind (fun x -> x :? 'T) |> Option.map (fun x -> x :?> 'T)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Replace with Array.tryPick

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Array.tryPick (function :? 'T as t -> Some t | _ -> None)


let inline tryGetAttribute2<'T when 'T :> Attribute> (attributes: obj[]) (attributes2: Attribute[]) =
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Please use System.Attribute as the type for the first input array. I'm assuming the two arguments are type-level vs. case level attributes? Naming of arguments should convey this.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'll rename them. But I can't change the type of the first argument, it's what UnionCaseInfo.GetCustomAttributes returns.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Pretty sure you could map the array though.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, everything in it is an Attribute, but why reallocate a second array with the exact same data to end up casting it out anyway ? There is no consumer that uses the fact that they are instances of Attribute.

In fact if it's ok with you i'll find what makes the second array contains Attribute and use obj instead. That's what https://msdn.microsoft.com/en-us/library/kff8s254(v=vs.110).aspx returns and any conversion is unneeded

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."

Expand All @@ -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

Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Could be inlined into a single Array.collect

|> 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
Expand All @@ -437,12 +458,12 @@ let rec private preComputeUnionCaseArgInfo (stack : Type list) (helpParam : Help
| [] when isMainCommand.Value ->
match parsers.Value with
| Primitives ps ->
let name = ps |> Seq.map (fun p -> sprintf "<%s>" p.Description) |> String.concat " "
let name = ps |> Seq.map (fun p -> "<" + p.Description + ">" ) |> String.concat " "
if isRest.Value then name + "..." else name
| ListParam(_,p) -> sprintf "<%s>..." p.Description
| _ -> arguExn "internal error in argu parser representation %O." uci
| ListParam(_,p) -> "<" + p.Description + ">..."
| _ -> raise <| new ArguException("internal error in argu parser representation " + (uci.ToString()) + ".")
| _ when Option.isSome appSettingsName.Value -> appSettingsName.Value.Value
| _ -> arguExn "parameter '%O' needs to have at least one parse source." uci)
| _ -> raise <| new ArguException("parameter '" + (uci.ToString()) + "' needs to have at least one parse source."))
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm not a fan of this change, premature optimization where raised exception would be the dominating factor. Please revert.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ah yes I need to measure, I changed all the printf initialization but I don't think this one is hit.


let fieldReader = Helpers.fieldReader uci
let fieldCtor = Helpers.tupleConstructor types
Expand Down
34 changes: 0 additions & 34 deletions src/Argu/Utils.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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) =
Expand Down