| | | 1 | | namespace FSharp.Interop.Dlr |
| | | 2 | | |
| | | 3 | | open System |
| | | 4 | | open System.Diagnostics.CodeAnalysis |
| | | 5 | | open System.Dynamic |
| | | 6 | | open System.Linq.Expressions |
| | | 7 | | open System.Reflection |
| | | 8 | | open System.Runtime.CompilerServices |
| | | 9 | | open Microsoft.CSharp.RuntimeBinder |
| | | 10 | | open FSharp.Quotations |
| | | 11 | | |
| | | 12 | | /// Whether a function type (the runtime type of a value, or a member's declared type) is an |
| | | 13 | | /// `FSharpFunc` that the call site's arguments fit, and the expression applying it. The shape |
| | | 14 | | /// comes from the function itself, not from the call's declared result: a discarded result or a |
| | | 15 | | /// widened one still applies the function that is there. Any arity: a curried function is a |
| | | 16 | | /// chain of `Invoke` calls, a tupled one a tuple construction and one `Invoke`. |
| | | 17 | | module internal FunctionShapes = |
| | | 18 | | let private isFunc (t: Type) = t.IsGenericType && t.GetGenericTypeDefinition() = typedefof<FSharpFunc<_, _>> |
| | | 19 | | |
| | | 20 | | let private fits (paramType: Type) (argType: Type) = Conversions.fits paramType argType |
| | | 21 | | |
| | | 22 | | /// A conversion for an argument that does not fit a domain by assignment or widening — an |
| | | 23 | | /// F# function for a delegate domain, a delegate for a function domain — supplied by |
| | | 24 | | /// `Fallback` once it exists (it is in `Seam.fs`, compiled after this file, and uses `applyCall` |
| | | 25 | | /// itself, for the largest delegates). None until then, and None when nothing applies. |
| | | 26 | | let mutable convertArgument : Type -> DynamicMetaObject -> Expression option = fun _ _ -> None |
| | | 27 | | |
| | | 28 | | let isNullValue (a: DynamicMetaObject) = a.HasValue && isNull a.Value |
| | | 29 | | |
| | | 30 | | /// The restriction a rule carries for one argument: its runtime type, or for a null value |
| | | 31 | | /// (a null reference, or `unit`, whose value is null) the instance: a type restriction can |
| | | 32 | | /// never hold for null, and a rule that fails its own test makes the DLR re-bind forever. |
| | | 33 | | let restrictArg (a: DynamicMetaObject) = |
| | | 34 | | if isNullValue a then BindingRestrictions.GetInstanceRestriction(a.Expression, null) |
| | | 35 | | else BindingRestrictions.GetTypeRestriction(a.Expression, a.LimitType) |
| | | 36 | | |
| | | 37 | | /// A null value fits any reference-type domain but `unit` whatever its static type (an untyped |
| | | 38 | | /// `null` is `obj`), as C# lets `null` go to any reference parameter; the rule then carries an |
| | | 39 | | /// instance restriction for it (`restrictions`). Not `unit`: that would let a one-argument |
| | | 40 | | /// call bind a zero-argument function because the argument happened to be null. |
| | | 41 | | let private fitsNull (domain: Type) (a: DynamicMetaObject) = |
| | | 42 | | isNullValue a && not domain.IsValueType && domain <> typeof<unit> |
| | | 43 | | |
| | | 44 | | let private fitsArg (domain: Type) (a: DynamicMetaObject) = |
| | | 45 | | fits domain a.LimitType || fitsNull domain a || (convertArgument domain a).IsSome |
| | | 46 | | |
| | | 47 | | /// The `FSharpFunc<_, _>` a type is or derives from: a function value's runtime type is a |
| | | 48 | | /// compiler-generated subclass (`f@12`), a member's declared type usually the base itself. |
| | | 49 | | let rec funcBase (t: Type) : Type option = |
| | | 50 | | if isNull t then None |
| | | 51 | | elif isFunc t then Some t |
| | | 52 | | else funcBase t.BaseType |
| | | 53 | | |
| | | 54 | | let private invoke (f: Expression) (funcType: Type) (arg: Expression) : Expression = |
| | | 55 | | Expression.Call(f, funcType.GetMethod("Invoke"), arg) :> Expression |
| | | 56 | | |
| | | 57 | | /// Through the LimitType first: an `obj`-typed argument is unboxed as its runtime type, then |
| | | 58 | | /// widened; converting `obj` straight to `int64` would unbox a boxed `int` as `int64` and throw. |
| | | 59 | | let private convertTo (t: Type) (a: DynamicMetaObject) = |
| | | 60 | | if fits t a.LimitType then |
| | | 61 | | let unboxed = if a.Expression.Type = a.LimitType then a.Expression else Expression.Convert(a.Expression, a.L |
| | | 62 | | if a.LimitType = t then unboxed else Expression.Convert(unboxed, t) :> Expression |
| | | 63 | | elif fitsNull t a then Expression.Convert(a.Expression, t) :> Expression |
| | | 64 | | else (convertArgument t a).Value |
| | | 65 | | |
| | | 66 | | /// A function type's parameter list and result: `(A * B) -> R` is `[A; B]` tupled, `A -> B -> R` |
| | | 67 | | /// is `[A; B]` curried (the chain followed as far as it is `FSharpFunc`), `A -> R` is `[A]`. |
| | | 68 | | let domains (funcType: Type) : (Type list * bool * Type) option = |
| | | 69 | | match funcBase funcType with |
| | | 70 | | | None -> None |
| | | 71 | | | Some ft -> |
| | | 72 | | let ga = ft.GetGenericArguments() |
| | | 73 | | if FSharp.Reflection.FSharpType.IsTuple ga.[0] then |
| | | 74 | | Some(List.ofArray (FSharp.Reflection.FSharpType.GetTupleElements ga.[0]), true, ga.[1]) |
| | | 75 | | else |
| | | 76 | | let rec chain (t: Type) (acc: Type list) = |
| | | 77 | | if isFunc t then |
| | | 78 | | let ga = t.GetGenericArguments() |
| | | 79 | | chain ga.[1] (ga.[0] :: acc) |
| | | 80 | | else List.rev acc, t |
| | | 81 | | let ds, r = chain ga.[1] [ ga.[0] ] |
| | | 82 | | Some(ds, false, r) |
| | | 83 | | |
| | | 84 | | /// `domains` as a delegate's parameters: a `unit -> R` takes none (a parameterless delegate). |
| | | 85 | | let parameters (funcType: Type) : (Type list * bool * Type) option = |
| | | 86 | | domains funcType |> Option.map (fun (ds, tupled, result) -> (if ds = [ typeof<unit> ] then [] else ds), tupled, |
| | | 87 | | |
| | | 88 | | /// The call applying `read` (an expression whose value is of `funcType`) with `args`, boxed, |
| | | 89 | | /// if the shape fits: `unit -> R` for no arguments, `A -> R` for one, and for more either a |
| | | 90 | | /// tuple domain of that size or a curried chain of that depth. |
| | | 91 | | let applyCall (funcType: Type) (read: Expression) (args: DynamicMetaObject[]) : Expression option = |
| | | 92 | | match funcBase funcType with |
| | | 93 | | | None -> None |
| | | 94 | | | Some ft -> |
| | | 95 | | let ga = ft.GetGenericArguments() |
| | | 96 | | let domain = ga.[0] |
| | | 97 | | let f = Expression.Convert(read, ft) :> Expression |
| | | 98 | | let boxed (e: Expression) = Expression.Convert(e, typeof<obj>) :> Expression |
| | | 99 | | match List.ofArray args with |
| | | 100 | | | [] when domain = typeof<unit> -> Some(boxed (invoke f ft (Expression.Constant(null, typeof<unit>)))) |
| | | 101 | | | [ a ] when fitsArg domain a -> Some(boxed (invoke f ft (convertTo domain a))) |
| | | 102 | | | [] | [ _ ] -> None |
| | | 103 | | | args -> |
| | | 104 | | let n = args.Length |
| | | 105 | | let tupled = |
| | | 106 | | if FSharp.Reflection.FSharpType.IsTuple domain then |
| | | 107 | | let es = List.ofArray (FSharp.Reflection.FSharpType.GetTupleElements domain) |
| | | 108 | | if es.Length = n && List.forall2 fitsArg es args then |
| | | 109 | | let tuple = Tuples.newExpression domain (List.map2 convertTo es args) |
| | | 110 | | Some(boxed (invoke f ft tuple)) |
| | | 111 | | else None |
| | | 112 | | else None |
| | | 113 | | match tupled with |
| | | 114 | | | Some call -> Some call |
| | | 115 | | | None -> |
| | | 116 | | // Curried: each domain in turn must fit. Up to five arguments `InvokeFast` applies |
| | | 117 | | // them in one call (no intermediate closures, as F# compiles `f a b`); past that |
| | | 118 | | // each step's result is the next function. |
| | | 119 | | match domains funcType with |
| | | 120 | | | Some(ds, false, result) when ds.Length = n && n <= 5 && List.forall2 fitsArg ds args -> |
| | | 121 | | // `FSharpFunc<T, U>.InvokeFast<V, …>(func, t, u, v, …)`: the declaring type takes the |
| | | 122 | | // first two domains, the method's own type parameters the rest and the result. |
| | | 123 | | let declaring = typedefof<FSharpFunc<_, _>>.MakeGenericType(ds.[0], ds.[1]) |
| | | 124 | | let fast = |
| | | 125 | | declaring.GetMethods() |
| | | 126 | | |> Array.find (fun m -> m.Name = "InvokeFast" && m.GetParameters().Length = n + 1) |
| | | 127 | | |> fun m -> m.MakeGenericMethod(Array.ofList (List.skip 2 ds @ [ result ])) |
| | | 128 | | let funcArg = Expression.Convert(read, fast.GetParameters().[0].ParameterType) :> Expression |
| | | 129 | | Some(boxed (Expression.Call(fast, funcArg :: List.map2 convertTo ds args))) |
| | | 130 | | | _ -> |
| | | 131 | | let rec chain (fe: Expression) (t: Type) (remaining: DynamicMetaObject list) = |
| | | 132 | | match remaining with |
| | | 133 | | | [] -> Some fe |
| | | 134 | | | a :: rest -> |
| | | 135 | | match funcBase t with |
| | | 136 | | | Some ft when fitsArg (ft.GetGenericArguments().[0]) a -> |
| | | 137 | | let ga = ft.GetGenericArguments() |
| | | 138 | | chain (invoke (Expression.Convert(fe, ft)) ft (convertTo ga.[0] a)) ga.[1] rest |
| | | 139 | | | _ -> None |
| | | 140 | | chain read funcType args |> Option.map boxed |
| | | 141 | | |
| | | 142 | | /// The rule's restrictions: the function's runtime type and each argument's (`restrictArg`). |
| | | 143 | | let restrictions (target: DynamicMetaObject) (targetType: Type) (args: DynamicMetaObject[]) = |
| | | 144 | | Array.fold (fun (r: BindingRestrictions) (a: DynamicMetaObject) -> r.Merge(restrictArg a)) |
| | | 145 | | (BindingRestrictions.GetTypeRestriction(target.Expression, targetType)) args |
| | | 146 | | |
| | | 147 | | /// A rule applying `value` with `args` if its runtime type is a fitting FSharpFunc: the DLR |
| | | 148 | | /// caches it under that type restriction, so a site keeps one rule per kind of value it sees. |
| | | 149 | | let tryApply (value: DynamicMetaObject) (args: DynamicMetaObject[]) : DynamicMetaObject option = |
| | | 150 | | match value.RuntimeType with |
| | | 151 | | | null -> None |
| | | 152 | | | runtime -> |
| | | 153 | | applyCall runtime value.Expression args |
| | | 154 | | |> Option.map (fun call -> DynamicMetaObject(call, restrictions value runtime args)) |
| | | 155 | | |
| | | 156 | | /// An instance property (non-indexed) or field of `t` named `name` that `context` may access: |
| | | 157 | | /// its type and a read. |
| | | 158 | | let clrMember (context: Type) (t: Type) (name: string) (target: DynamicMetaObject) : (Type * Expression) option = |
| | | 159 | | let self = Expression.Convert(target.Expression, t) |
| | | 160 | | let property = |
| | | 161 | | t.GetProperties(Accessibility.all) |
| | | 162 | | |> Array.tryFind (fun p -> |
| | | 163 | | p.Name = name && p.GetIndexParameters().Length = 0 |
| | | 164 | | && (let g = p.GetGetMethod(true) in not (isNull g) && Accessibility.method' context t g)) |
| | | 165 | | match property with |
| | | 166 | | | Some p -> Some(p.PropertyType, Expression.Property(self, p) :> Expression) |
| | | 167 | | | None -> |
| | | 168 | | match t.GetFields(Accessibility.all) |> Array.tryFind (fun f -> f.Name = name && Accessibility.field context |
| | | 169 | | | None -> None |
| | | 170 | | | Some f -> Some(f.FieldType, Expression.Field(self, f) :> Expression) |
| | | 171 | | |
| | | 172 | | /// Whether a member's declared type says nothing useful about whether it holds a function: |
| | | 173 | | /// `obj`, an interface, an abstract class. Its value then goes through a nested site. |
| | | 174 | | let opaque (t: Type) = t = typeof<obj> || t.IsInterface || (t.IsAbstract && not t.IsSealed) |
| | | 175 | | |
| | | 176 | | /// One step of a function `FunctionBuilder` builds: the step before it (`Prev`; for the first, the |
| | | 177 | | /// captured values as a `Tuple`), the argument that step took (`Own`; for the first, null), and |
| | | 178 | | /// `next`, compiled once, which takes this step with its argument — the whole tuple, for a tupled |
| | | 179 | | /// function — to the next step or, at the last, the call, reading the arguments back along `Prev`. |
| | | 180 | | /// One object per step, no closure and nothing copied. Everything it holds is a class or a |
| | | 181 | | /// domain's own type: a struct over references as a type argument here (a `ValueTuple` |
| | | 182 | | /// accumulator) put each step on the runtime's slow shared-generic path, three times the cost. A |
| | | 183 | | /// class of its own rather than `FuncConvert`, whose wrappers lose their argument on Mono's |
| | | 184 | | /// interpreter (wasm). |
| | | 185 | | /// Not part of the supported API: public only because compiled blocks call it, and it may change in any release. |
| | | 186 | | [<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)>] |
| | | 187 | | type CurriedStep<'Prev, 'Own, 'A, 'R>(prev: 'Prev, own: 'Own, next: Func<CurriedStep<'Prev, 'Own, 'A, 'R>, 'A, 'R>) = |
| | | 188 | | inherit FSharpFunc<'A, 'R>() |
| | | 189 | | member _.Prev = prev |
| | | 190 | | member _.Own = own |
| | | 191 | | override this.Invoke(a: 'A) : 'R = next.Invoke(this, a) |
| | | 192 | | |
| | | 193 | | /// F# functions past five arguments as LINQ, compiled once per (function type, site type) — or |
| | | 194 | | /// per (function type, delegate type): tupled, one `CurriedStep` taking the whole tuple, its |
| | | 195 | | /// elements read through `Rest`; curried, a `CurriedStep` per argument — what F# emits for a |
| | | 196 | | /// curried function beyond OptimizedClosures, minus InvokeFast. Typed throughout: no boxing, no `DynamicInvoke`, and wh |
| | | 197 | | /// the call throws arrives as itself. |
| | | 198 | | module internal FunctionBuilder = |
| | | 199 | | /// The F# function whose result is `call captured args`: tupled over `tupleType` when given |
| | | 200 | | /// (`domains` its elements), else curried over `domains`; `captured` (one to seven: sites, |
| | | 201 | | /// target, delegate) are values from the enclosing lambda, handed to `call` as expressions |
| | | 202 | | /// valid where it is placed. `resultType` is the function's final result, which `call` produces. |
| | | 203 | | let build (tupleType: Type option) (domains: Type list) (resultType: Type) (captured: Expression list) |
| | | 204 | | (call: Expression list -> Expression list -> Expression) : Expression = |
| | | 205 | | let capturedType = typedefof<Tuple<_>>.Assembly.GetType(sprintf "System.Tuple`%d" captured.Length).MakeGenericTy |
| | | 206 | | // The steps' argument types: the tuple alone, or each argument. |
| | | 207 | | let steps = match tupleType with Some t -> [ t ] | None -> domains |
| | | 208 | | let n = steps.Length |
| | | 209 | | let rec funcType k = if k = n then resultType else typedefof<FSharpFunc<_, _>>.MakeGenericType(steps.[k], funcTy |
| | | 210 | | let rec stepType k = |
| | | 211 | | let prev, own = if k = 0 then capturedType, typeof<obj> else stepType (k - 1), steps.[k - 1] |
| | | 212 | | typedefof<CurriedStep<_, _, _, _>>.MakeGenericType(prev, own, steps.[k], funcType (k + 1)) |
| | | 213 | | let newStep k (prev: Expression) (own: Expression) (next: Delegate) = |
| | | 214 | | Expression.Convert(Expression.New((stepType k).GetConstructors().[0], prev, own, Expression.Constant(next)), |
| | | 215 | | // `next` of step k: on to step k+1, or, at the last, the call. |
| | | 216 | | let rec next k : Delegate = |
| | | 217 | | let self = Expression.Parameter(stepType k, "self") |
| | | 218 | | let a = Expression.Parameter(steps.[k], "a") |
| | | 219 | | let body = |
| | | 220 | | if k < n - 1 then newStep (k + 1) self a (next (k + 1)) |
| | | 221 | | else |
| | | 222 | | // Step j is n-1-j `Prev`s up; argument i is step i+1's `Own`. |
| | | 223 | | let rec up (j: int) : Expression = if j = n - 1 then self else Expression.Property(up (j + 1), "Prev |
| | | 224 | | let capturedValues = [ for i in 0 .. captured.Length - 1 -> Expression.Property(Expression.Property( |
| | | 225 | | let args = |
| | | 226 | | match tupleType with |
| | | 227 | | | Some _ -> [ for i in 0 .. domains.Length - 1 -> Tuples.element a i ] |
| | | 228 | | | None -> [ for i in 0 .. n - 2 -> Expression.Property(up (i + 1), "Own") :> Expression ] @ [ a |
| | | 229 | | call capturedValues args |
| | | 230 | | Expression.Lambda(typedefof<Func<_, _, _>>.MakeGenericType(stepType k, steps.[k], funcType (k + 1)), body, " |
| | | 231 | | newStep 0 (Expression.New(capturedType.GetConstructors().[0], captured)) (Expression.Constant(null, typeof<obj>) |
| | | 232 | | |
| | | 233 | | /// A void call as an F# `unit` result. |
| | | 234 | | let unitOf (call: Expression) : Expression = |
| | | 235 | | if call.Type = typeof<Void> then Expression.Block(typeof<unit>, call, Expression.Constant(null, typeof<unit>)) : |
| | | 236 | | |
| | | 237 | | /// The typed wrapper (`DelegateFunctions`, in Adapters.fs) for a delegate passed to a |
| | | 238 | | /// function-typed parameter. |
| | | 239 | | module internal DelegateConversions = |
| | | 240 | | let private makers = System.Collections.Concurrent.ConcurrentDictionary<struct (Type * Type), (Delegate -> obj) opti |
| | | 241 | | |
| | | 242 | | /// A maker of the typed wrapper for a function type from a delegate type, or None when the |
| | | 243 | | /// signatures do not fit (`Signatures.delegateServesFunction`) — then the binder does not offer the conversion |
| | | 244 | | /// (`delegateToFunction`), and None is cached like a maker. The delegate is rebound to the |
| | | 245 | | /// `Func`/`Action` of the function's signature over its own `Invoke`; past five |
| | | 246 | | /// parameters, a factory compiled once calls the delegate type's own `Invoke`. |
| | | 247 | | let tryTyped (funcType: Type) (delegateType: Type) : (Delegate -> obj) option = |
| | | 248 | | match makers.TryGetValue(struct (funcType, delegateType)) with |
| | | 249 | | | true, m -> m |
| | | 250 | | | _ -> |
| | | 251 | | let invoke = DelegateMembers.invokeOf delegateType |
| | | 252 | | let ps = [ for p in invoke.GetParameters() -> p.ParameterType ] |
| | | 253 | | let isVoid = invoke.ReturnType = typeof<Void> |
| | | 254 | | let maker = |
| | | 255 | | match FunctionShapes.parameters funcType with |
| | | 256 | | | Some(ds, tupled, result) -> |
| | | 257 | | let n = ds.Length |
| | | 258 | | if not (Signatures.delegateServesFunction ds result ps invoke.ReturnType) || (tupled && n < 2) then |
| | | 259 | | elif n > 5 then |
| | | 260 | | // Past the typed wrappers: a factory compiled once (FunctionBuilder) calling |
| | | 261 | | // this delegate type's own Invoke. |
| | | 262 | | let d = Expression.Parameter(typeof<Delegate>, "d") |
| | | 263 | | let typed = Expression.Convert(d, delegateType) |
| | | 264 | | let body = |
| | | 265 | | FunctionBuilder.build (if tupled then Some (funcType.GetGenericArguments().[0]) else None) d |
| | | 266 | | (fun captured args -> FunctionBuilder.unitOf (Expression.Call(List.head captured, invoke |
| | | 267 | | let factory = Expression.Lambda<Func<Delegate, obj>>(Expression.Convert(body, typeof<obj>), "dlr |
| | | 268 | | Some factory.Invoke |
| | | 269 | | else |
| | | 270 | | let standard = if isVoid then Expression.GetActionType(Array.ofList ds) else Expression.GetFuncT |
| | | 271 | | let name = (if tupled then "Tupled" else "") + (if isVoid then "Action" else "Func") + string n |
| | | 272 | | let def = typeof<DelegateFunctions.Action0<unit>>.DeclaringType.GetNestedType(name + "`" + strin |
| | | 273 | | let closed = def.MakeGenericType(Array.ofList (ds @ [ result ])) |
| | | 274 | | let ctor = closed.GetConstructors().[0] |
| | | 275 | | // `new Wrapper(d)`. |
| | | 276 | | let construct = |
| | | 277 | | Emit.factory<Func<Delegate, obj>> "wrap" typeof<obj> [| typeof<Delegate> |] closed.Module |
| | | 278 | | (fun il -> |
| | | 279 | | il.Emit(System.Reflection.Emit.OpCodes.Ldarg_0) |
| | | 280 | | il.Emit(System.Reflection.Emit.OpCodes.Castclass, standard) |
| | | 281 | | il.Emit(System.Reflection.Emit.OpCodes.Newobj, ctor) |
| | | 282 | | il.Emit(System.Reflection.Emit.OpCodes.Ret)) |
| | | 283 | | (fun () -> Func<Delegate, obj>(fun d -> ctor.Invoke [| box d |])) |
| | | 284 | | Some(fun (d: Delegate) -> |
| | | 285 | | // Rebound over the delegate's own `Invoke`, not its last target and method: |
| | | 286 | | // a multicast delegate keeps every target. |
| | | 287 | | let standardDelegate = if d.GetType() = standard then d else Delegate.CreateDelegate(standar |
| | | 288 | | construct.Invoke standardDelegate) |
| | | 289 | | | None -> None |
| | | 290 | | makers.[struct (funcType, delegateType)] <- maker |
| | | 291 | | maker |
| | | 292 | | |
| | | 293 | | |
| | | 294 | | /// Not part of the supported API: public only because compiled blocks call it, and it may change in any release. |
| | | 295 | | [<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)>] |
| | | 296 | | module DelegateFunction = |
| | | 297 | | /// The F# function of `funcType` over `d` — always a typed wrapper: the binder offers the |
| | | 298 | | /// conversion only when `DelegateConversions.tryTyped` has one (`delegateToFunction`). |
| | | 299 | | let Make (funcType: Type) (d: Delegate) : obj = |
| | 180 | 300 | | match DelegateConversions.tryTyped funcType (d.GetType()) with |
| | 180 | 301 | | | Some make -> make d |
| | 0 | 302 | | | None -> invalidOp (sprintf "No conversion of %s to %s: the binder offers only those tryTyped makes." (d.GetTyp |
| | | 303 | | |
| | | 304 | | /// `Make` as a method, for the expression tree of a bound call to name it. |
| | | 305 | | let makeMethod : MethodInfo = Quotation.methodOf <@ Make typeof<obj> null @> |
| | | 306 | | |
| | | 307 | | |
| | | 308 | | /// A delegate literal written inside a block (`w?Each(Action<string>(fun s -> …))`) compiles with |
| | | 309 | | /// the block, as a `DynamicMethod` delegate whose `.Method` has a hidden `Closure` first parameter; |
| | | 310 | | /// a consumer marshalling by `.Method` (NLua, some event-wiring helpers) sees `(Closure, string)` |
| | | 311 | | /// and refuses it. `Over` re-wraps it on the delegate type's own `Invoke`, so `.Method` is honest and |
| | | 312 | | /// `.Target` the inner delegate — one indirection per call — through a factory emitted once per |
| | | 313 | | /// delegate type (`dup; ldvirtftn Invoke; newobj`), or `Delegate.CreateDelegate` where dynamic code is not |
| | | 314 | | /// supported. The seam's past-sixteen-parameter conversion, a compiled lambda too, goes through |
| | | 315 | | /// it as well. Public: compiled blocks call `Over`. |
| | | 316 | | /// Not part of the supported API: public only because compiled blocks call it, and it may change in any release. |
| | | 317 | | [<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)>] |
| | | 318 | | type DelegateLiteral<'D when 'D :> Delegate> [<ExcludeFromCodeCoverage>] private () = |
| | | 319 | | static let factory : Func<'D, 'D> = |
| | | 320 | | let delegateType = typeof<'D> |
| | | 321 | | let invoke = DelegateMembers.invokeOf delegateType |
| | | 322 | | Emit.factory<Func<'D, 'D>> "rewrap" delegateType [| delegateType |] delegateType.Module |
| | | 323 | | (fun il -> |
| | | 324 | | il.Emit(System.Reflection.Emit.OpCodes.Ldarg_0) |
| | | 325 | | il.Emit(System.Reflection.Emit.OpCodes.Dup) |
| | | 326 | | il.Emit(System.Reflection.Emit.OpCodes.Ldvirtftn, invoke) // `Invoke` is virtual; the JIT accepts only |
| | | 327 | | il.Emit(System.Reflection.Emit.OpCodes.Newobj, DelegateMembers.constructorOf delegateType) |
| | | 328 | | il.Emit(System.Reflection.Emit.OpCodes.Ret)) |
| | | 329 | | (fun () -> Func<'D, 'D>(fun inner -> Delegate.CreateDelegate(delegateType, inner, invoke) :?> 'D)) |
| | | 330 | | |
| | | 331 | | static member Over(inner: 'D) : 'D = factory.Invoke inner |
| | | 332 | | |
| | | 333 | | /// A literal compiled at a stand-in delegate type of the same signature (a Func or Action; |
| | | 334 | | /// see Translate's `NewDelegate`), as this type, and re-wrapped as `Over` does. |
| | | 335 | | static member From(inner: Delegate) : 'D = |
| | | 336 | | DelegateLiteral<'D>.Over(Delegate.CreateDelegate(typeof<'D>, inner, DelegateMembers.invokeOf (inner.GetType())) |
| | | 337 | | |
| | | 338 | | /// A parameterless delegate literal in a block (`Func<int>(fun () -> 7)`, `Action(fun () -> …)`, |
| | | 339 | | /// #156): F# quotes it in a form no rewrite can rebuild, so the translator hands its body over as |
| | | 340 | | /// the thunk `fun () -> body` and this makes the `'D` over it — by the literal's own type, which |
| | | 341 | | /// the compiler fixed, not by the shape of the thunk (a `Func<unit>`, or a `Func<int -> int>` whose |
| | | 342 | | /// result is itself a function, are what a run-time conversion would misread). A factory compiled |
| | | 343 | | /// once per delegate type: `'D` calling the thunk, re-wrapped as `DelegateLiteral.Over` does, and |
| | | 344 | | /// on .NET Framework built at the public stand-in for an `internal` type. Public: compiled blocks |
| | | 345 | | /// call `Of`. |
| | | 346 | | /// Not part of the supported API: public only because compiled blocks call it, and it may change in any release. |
| | | 347 | | [<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)>] |
| | | 348 | | type ParameterlessLiteral<'D, 'R when 'D :> Delegate> [<ExcludeFromCodeCoverage>] private () = |
| | | 349 | | static let factory : Func<FSharpFunc<unit, 'R>, 'D> = |
| | | 350 | | let delegateType = typeof<'D> |
| | | 351 | | let f = Expression.Parameter(typeof<FSharpFunc<unit, 'R>>, "f") |
| | | 352 | | let call = Expression.Call(f, typeof<FSharpFunc<unit, 'R>>.GetMethod("Invoke"), Expression.Constant(null, typeof |
| | | 353 | | let invoke = DelegateMembers.invokeOf delegateType |
| | | 354 | | let body = if invoke.ReturnType = typeof<Void> then Expression.Block(typeof<Void>, [| call |]) :> Expression els |
| | | 355 | | let honest = |
| | | 356 | | match DelegateMembers.standIn delegateType with |
| | | 357 | | | Some standIn -> Expression.Call(typeof<DelegateLiteral<'D>>.GetMethod("From"), Expression.Convert(Expressi |
| | | 358 | | | None -> Expression.Call(typeof<DelegateLiteral<'D>>.GetMethod("Over"), Expression.Lambda(delegateType, bod |
| | | 359 | | Expression.Lambda<Func<FSharpFunc<unit, 'R>, 'D>>(honest, "dlr-parameterlessLiteral", [ f ]).Compile() |
| | | 360 | | static member Of(thunk: FSharpFunc<unit, 'R>) : 'D = factory.Invoke thunk |
| | | 361 | | |
| | | 362 | | /// A delegate over an F# function (`FunctionAdapters`, in Adapters.fs): per (function type, |
| | | 363 | | /// delegate type) a factory emitted once as IL — `new Adapter(f)` and the delegate constructor |
| | | 364 | | /// over its `Invoke` — so a conversion costs an allocation, not `Delegate.CreateDelegate`'s |
| | | 365 | | /// per-call validation (~300 ns) or a LINQ closure (about the same). Where dynamic code is not |
| | | 366 | | /// supported, `CreateDelegate` it is. Past sixteen parameters (a custom delegate type), a |
| | | 367 | | /// compiled lambda applying the function. Public: compiled blocks call `Make`. |
| | | 368 | | /// Not part of the supported API: public only because compiled blocks call it, and it may change in any release. |
| | | 369 | | [<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)>] |
| | | 370 | | module FunctionConversions = |
| | | 371 | | let private conversions = System.Collections.Concurrent.ConcurrentDictionary<struct (Type * Type), Func<obj, Delegat |
| | | 372 | | |
| | | 373 | | /// `fun x -> delegate ctor over Invoke` of `adapter` (a `FunctionAdapters` or `MemberInvokers` |
| | | 374 | | /// type): the instance `x` itself or, with `wrap`, `new adapter(x)`; as IL when the runtime |
| | | 375 | | /// allows it. |
| | | 376 | | let private emitBinding (delegateType: Type) (adapter: Type) (wrap: bool) : Func<obj, Delegate> = |
| | | 377 | | let ctor = adapter.GetConstructors().[0] |
| | | 378 | | let invoke = adapter.GetMethod("Invoke") |
| | | 379 | | Emit.factory<Func<obj, Delegate>> "make" typeof<Delegate> [| typeof<obj> |] adapter.Module |
| | | 380 | | (fun il -> |
| | | 381 | | il.Emit(System.Reflection.Emit.OpCodes.Ldarg_0) |
| | | 382 | | if wrap then |
| | | 383 | | il.Emit(System.Reflection.Emit.OpCodes.Castclass, ctor.GetParameters().[0].ParameterType) |
| | | 384 | | il.Emit(System.Reflection.Emit.OpCodes.Newobj, ctor) |
| | | 385 | | else il.Emit(System.Reflection.Emit.OpCodes.Castclass, adapter) |
| | | 386 | | il.Emit(System.Reflection.Emit.OpCodes.Ldftn, invoke) |
| | | 387 | | il.Emit(System.Reflection.Emit.OpCodes.Newobj, DelegateMembers.constructorOf delegateType) |
| | | 388 | | il.Emit(System.Reflection.Emit.OpCodes.Ret)) |
| | | 389 | | (fun () -> Func<obj, Delegate>(fun x -> Delegate.CreateDelegate(delegateType, (if wrap then ctor.Invoke [| x |
| | | 390 | | |
| | | 391 | | /// `fun f -> new Adapter(f) |> delegate ctor over Invoke`. |
| | | 392 | | let private emitFactory (delegateType: Type) (adapter: Type) : Func<obj, Delegate> = emitBinding delegateType adapte |
| | | 393 | | |
| | | 394 | | let private bindings = System.Collections.Concurrent.ConcurrentDictionary<struct (Type * Type), Func<obj, Delegate>> |
| | | 395 | | |
| | | 396 | | /// The factory binding `delegateType` to an instance of `instanceType` (a `MemberInvokers` |
| | | 397 | | /// type, whose `Invoke` has the delegate's signature), once per pair. |
| | | 398 | | let over (instanceType: Type) (delegateType: Type) : Func<obj, Delegate> = |
| | | 399 | | bindings.GetOrAdd(struct (instanceType, delegateType), fun _ -> emitBinding delegateType instanceType false) |
| | | 400 | | |
| | | 401 | | /// The factory for `delegateType` from a function value of `funcType`, or None when the shapes |
| | | 402 | | /// do not fit (`Signatures.functionServesDelegate`). |
| | | 403 | | let tryConversion (funcType: Type) (delegateType: Type) : Func<obj, Delegate> option = |
| | | 404 | | match conversions.TryGetValue(struct (funcType, delegateType)) with |
| | | 405 | | | true, c -> c |
| | | 406 | | | _ -> |
| | | 407 | | let invoke = DelegateMembers.invokeOf delegateType |
| | | 408 | | let ps = [ for p in invoke.GetParameters() -> p.ParameterType ] |
| | | 409 | | let isVoid = invoke.ReturnType = typeof<Void> |
| | | 410 | | let conversion = |
| | | 411 | | match FunctionShapes.parameters funcType with |
| | | 412 | | | Some(ds, tupled, result) -> |
| | | 413 | | let n = ds.Length |
| | | 414 | | if not (Signatures.functionServesDelegate ds result ps invoke.ReturnType) || (tupled && n < 2) then |
| | | 415 | | elif n <= 16 then |
| | | 416 | | let name = (if tupled then "Tupled" else "Curried") + string n + (if isVoid then "Unit" else "") |
| | | 417 | | let arity = n + (if isVoid then 0 else 1) |
| | | 418 | | let def = typeof<FunctionAdapters.Curried0Unit>.DeclaringType.GetNestedType(name + (if arity > 0 |
| | | 419 | | let closed = if def.IsGenericTypeDefinition then def.MakeGenericType(Array.ofList (ds @ (if isVo |
| | | 420 | | Some(emitFactory delegateType closed) |
| | | 421 | | else |
| | | 422 | | let fParam = Expression.Parameter(typeof<obj>, "f") |
| | | 423 | | let parameters = [| for p in invoke.GetParameters() -> Expression.Parameter(p.ParameterType, p.N |
| | | 424 | | let args = [| for p in parameters -> DynamicMetaObject(p, BindingRestrictions.Empty) |] |
| | | 425 | | FunctionShapes.applyCall funcType (Expression.Convert(fParam, funcType)) args |
| | | 426 | | |> Option.map (fun call -> |
| | | 427 | | let body = |
| | | 428 | | if isVoid then Expression.Block(typeof<Void>, [| call |]) :> Expression |
| | | 429 | | else Expression.Convert(call, invoke.ReturnType) :> Expression |
| | | 430 | | let literalOf = typedefof<DelegateLiteral<_>>.MakeGenericType delegateType |
| | | 431 | | let honest = |
| | | 432 | | match DelegateMembers.standIn delegateType with |
| | | 433 | | | Some standIn -> Expression.Call(literalOf.GetMethod("From"), Expression.Convert(Expres |
| | | 434 | | | None -> Expression.Call(literalOf.GetMethod("Over"), Expression.Lambda(delegateType, b |
| | | 435 | | Expression.Lambda<Func<obj, Delegate>>(Expression.Convert(honest, typeof<Delegate>), "dlr-fu |
| | | 436 | | | None -> None |
| | | 437 | | conversions.[struct (funcType, delegateType)] <- conversion |
| | | 438 | | conversion |
| | | 439 | | |
| | | 440 | | /// The delegate over `f`. |
| | | 441 | | let Make (delegateType: Type) (f: obj) : Delegate = |
| | | 442 | | match tryConversion (f.GetType()) delegateType with |
| | | 443 | | | Some factory -> factory.Invoke f |
| | | 444 | | | None -> raise (RuntimeBinderException(sprintf "Cannot convert an F# function of type '%s' to '%s'" (f.GetType( |
| | | 445 | | |
| | | 446 | | /// `Make` as a method, for the expression tree of a bound call to name it. |
| | | 447 | | let makeMethod : MethodInfo = Quotation.methodOf <@ Make typeof<obj> null @> |
| | | 448 | | |
| | | 449 | | /// What a member read as a delegate type yields when the member is a method, or the target a |
| | | 450 | | /// dynamic object with nothing to read (`FSharpGetMemberOrMethodBinder`): the block then makes |
| | | 451 | | /// the delegate an invoker of it. |
| | | 452 | | /// Not part of the supported API: public only because compiled blocks call it, and it may change in any release. |
| | | 453 | | [<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)>] |
| | | 454 | | [<Sealed>] |
| | | 455 | | type MethodGroup private () = |
| | | 456 | | static let instance = MethodGroup() |
| | | 457 | | static member Instance : obj = box instance |
| | | 458 | | static member Is(value: obj) = obj.ReferenceEquals(value, instance) |
| | | 459 | | |
| | | 460 | | /// A member read as an F# function type: `let f: int -> int -> int = dlr { return x?Add }`. The |
| | | 461 | | /// value is an F# function (curried, so partial application works) that invokes the member with |
| | | 462 | | /// the collected arguments when fully applied and converts the result; the site's binder handles |
| | | 463 | | /// methods, delegates and F# function values. Tupled variants for `A * B -> R`. |
| | | 464 | | /// Not part of the supported API: public only because compiled blocks call it, and it may change in any release. |
| | | 465 | | [<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)>] |
| | | 466 | | [<AbstractClass; Sealed>] |
| | | 467 | | type FunctionMember = |
| | | 468 | | static member Curried0<'R>(invoke: CallSite<Func<CallSite, obj, obj>>, convert: CallSite<Func<CallSite, obj, 'R>>, t |
| | | 469 | | fun () -> convert.Target.Invoke(convert, invoke.Target.Invoke(invoke, target)) |
| | | 470 | | static member Curried1<'A, 'R>(invoke: CallSite<Func<CallSite, obj, 'A, obj>>, convert: CallSite<Func<CallSite, obj, |
| | | 471 | | fun a -> convert.Target.Invoke(convert, invoke.Target.Invoke(invoke, target, a)) |
| | | 472 | | static member Curried2<'A, 'B, 'R>(invoke: CallSite<Func<CallSite, obj, 'A, 'B, obj>>, convert: CallSite<Func<CallSi |
| | | 473 | | fun a b -> convert.Target.Invoke(convert, invoke.Target.Invoke(invoke, target, a, b)) |
| | | 474 | | static member Curried3<'A, 'B, 'C, 'R>(invoke: CallSite<Func<CallSite, obj, 'A, 'B, 'C, obj>>, convert: CallSite<Fun |
| | | 475 | | fun a b c -> convert.Target.Invoke(convert, invoke.Target.Invoke(invoke, target, a, b, c)) |
| | | 476 | | static member Curried4<'A, 'B, 'C, 'D, 'R>(invoke: CallSite<Func<CallSite, obj, 'A, 'B, 'C, 'D, obj>>, convert: Call |
| | | 477 | | fun a b c d -> convert.Target.Invoke(convert, invoke.Target.Invoke(invoke, target, a, b, c, d)) |
| | | 478 | | static member Tupled2<'A, 'B, 'R>(invoke: CallSite<Func<CallSite, obj, 'A, 'B, obj>>, convert: CallSite<Func<CallSit |
| | | 479 | | fun (a, b) -> convert.Target.Invoke(convert, invoke.Target.Invoke(invoke, target, a, b)) |
| | | 480 | | static member Tupled3<'A, 'B, 'C, 'R>(invoke: CallSite<Func<CallSite, obj, 'A, 'B, 'C, obj>>, convert: CallSite<Func |
| | | 481 | | fun (a, b, c) -> convert.Target.Invoke(convert, invoke.Target.Invoke(invoke, target, a, b, c)) |
| | | 482 | | static member Tupled4<'A, 'B, 'C, 'D, 'R>(invoke: CallSite<Func<CallSite, obj, 'A, 'B, 'C, 'D, obj>>, convert: CallS |
| | | 483 | | fun (a, b, c, d) -> convert.Target.Invoke(convert, invoke.Target.Invoke(invoke, target, a, b, c, d)) |
| | | 484 | | static member Curried5<'A, 'B, 'C, 'D, 'E, 'R>(invoke: CallSite<Func<CallSite, obj, 'A, 'B, 'C, 'D, 'E, obj>>, conve |
| | | 485 | | fun a b c d e -> convert.Target.Invoke(convert, invoke.Target.Invoke(invoke, target, a, b, c, d, e)) |
| | | 486 | | static member Tupled5<'A, 'B, 'C, 'D, 'E, 'R>(invoke: CallSite<Func<CallSite, obj, 'A, 'B, 'C, 'D, 'E, obj>>, conver |
| | | 487 | | fun (a, b, c, d, e) -> convert.Target.Invoke(convert, invoke.Target.Invoke(invoke, target, a, b, c, d, e)) |
| | | 488 | | // `… -> unit`: a void site, nothing to convert. |
| | | 489 | | static member Curried0Unit(invoke: CallSite<Action<CallSite, obj>>, target: obj) : unit -> unit = |
| | | 490 | | fun () -> invoke.Target.Invoke(invoke, target) |
| | | 491 | | static member Curried1Unit<'A>(invoke: CallSite<Action<CallSite, obj, 'A>>, target: obj) : 'A -> unit = |
| | | 492 | | fun a -> invoke.Target.Invoke(invoke, target, a) |
| | | 493 | | static member Curried2Unit<'A, 'B>(invoke: CallSite<Action<CallSite, obj, 'A, 'B>>, target: obj) : 'A -> 'B -> unit |
| | | 494 | | fun a b -> invoke.Target.Invoke(invoke, target, a, b) |
| | | 495 | | static member Curried3Unit<'A, 'B, 'C>(invoke: CallSite<Action<CallSite, obj, 'A, 'B, 'C>>, target: obj) : 'A -> 'B |
| | | 496 | | fun a b c -> invoke.Target.Invoke(invoke, target, a, b, c) |
| | | 497 | | static member Curried4Unit<'A, 'B, 'C, 'D>(invoke: CallSite<Action<CallSite, obj, 'A, 'B, 'C, 'D>>, target: obj) : ' |
| | | 498 | | fun a b c d -> invoke.Target.Invoke(invoke, target, a, b, c, d) |
| | | 499 | | static member Tupled2Unit<'A, 'B>(invoke: CallSite<Action<CallSite, obj, 'A, 'B>>, target: obj) : 'A * 'B -> unit = |
| | | 500 | | fun (a, b) -> invoke.Target.Invoke(invoke, target, a, b) |
| | | 501 | | static member Tupled3Unit<'A, 'B, 'C>(invoke: CallSite<Action<CallSite, obj, 'A, 'B, 'C>>, target: obj) : 'A * 'B * |
| | | 502 | | fun (a, b, c) -> invoke.Target.Invoke(invoke, target, a, b, c) |
| | | 503 | | static member Tupled4Unit<'A, 'B, 'C, 'D>(invoke: CallSite<Action<CallSite, obj, 'A, 'B, 'C, 'D>>, target: obj) : 'A |
| | | 504 | | fun (a, b, c, d) -> invoke.Target.Invoke(invoke, target, a, b, c, d) |
| | | 505 | | static member Curried5Unit<'A, 'B, 'C, 'D, 'E>(invoke: CallSite<Action<CallSite, obj, 'A, 'B, 'C, 'D, 'E>>, target: |
| | | 506 | | fun a b c d e -> invoke.Target.Invoke(invoke, target, a, b, c, d, e) |
| | | 507 | | static member Tupled5Unit<'A, 'B, 'C, 'D, 'E>(invoke: CallSite<Action<CallSite, obj, 'A, 'B, 'C, 'D, 'E>>, target: o |
| | | 508 | | fun (a, b, c, d, e) -> invoke.Target.Invoke(invoke, target, a, b, c, d, e) |