| | | 1 | | namespace FSharp.Interop.Dlr |
| | | 2 | | |
| | | 3 | | open System |
| | | 4 | | open System.Linq.Expressions |
| | | 5 | | open FSharp.Quotations |
| | | 6 | | open FSharp.Quotations.Patterns |
| | | 7 | | open FSharp.Quotations.DerivedPatterns |
| | | 8 | | open FSharp.Quotations.ExprShape |
| | | 9 | | open FSharp.Reflection |
| | | 10 | | open Microsoft.FSharp.Linq.RuntimeHelpers |
| | | 11 | | open System.Runtime.CompilerServices |
| | | 12 | | |
| | | 13 | | /// <summary>The state machine's data slot; the builder's <c>Return</c> writes it so the value stays live in the compile |
| | | 14 | | /// <remarks>Not part of the supported API: public only because compiled blocks call it, and it may change in any releas |
| | | 15 | | [<Struct; NoComparison; NoEquality; System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Nev |
| | | 16 | | type DlrData<'T> = |
| | | 17 | | [<DefaultValue(false)>] |
| | | 18 | | val mutable Result: 'T |
| | | 19 | | |
| | | 20 | | /// <summary>The compiled block over its state machine, by reference: no copy of the struct at the call, |
| | | 21 | | /// none of the delegate-with-a-struct-argument cost a <c>Func<'SM, 'T></c> has (measured 4x slower). |
| | | 22 | | /// Public, and not for direct use: an F# <c>internal</c> delegate's <c>Invoke</c> is internal too, and |
| | | 23 | | /// .NET Framework's <c>Expression.Lambda</c> finds <c>Invoke</c> by public lookup only (#125).</summary> |
| | | 24 | | /// <remarks>Not part of the supported API: public only because compiled blocks call it, and it may change in any releas |
| | | 25 | | [<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)>] |
| | | 26 | | type DlrReader<'SM, 'T> = delegate of inref<'SM> -> 'T |
| | | 27 | | |
| | | 28 | | /// The translator's view of a reflected body: the markers (`opMethod`), the member-operation |
| | | 29 | | /// patterns, evaluation order (`sequenced`) and `normalize`, which applies a piped or curried |
| | | 30 | | /// marker to its arguments before any other rewrite. |
| | | 31 | | module internal TranslatePatterns = |
| | | 32 | | let unsupported (what: string) (e: Expr) = |
| | 60 | 33 | | raise (DlrTranslationException(sprintf "dlr { } does not support %s: %A" what e)) |
| | | 34 | | |
| | | 35 | | let genericDef (mi: Reflection.MethodInfo) = |
| | 1946642 | 36 | | if mi.IsGenericMethod then mi.GetGenericMethodDefinition() else mi |
| | | 37 | | |
| | | 38 | | /// The generic definition of the method a marker quotation calls. Curried static members |
| | | 39 | | /// quote as applications of an inner lambda, so this looks for the first call anywhere. |
| | 86 | 40 | | let opMethod (e: Expr<_>) = genericDef (Quotation.methodOf e) |
| | | 41 | | |
| | | 42 | | let opDynamic = opMethod <@ fun (t: obj) (n: string) -> ((?) t n) : obj @> |
| | | 43 | | let opDynamicAssign = opMethod <@ fun (t: obj) (n: string) (v: obj) -> (?<-) t n v @> |
| | | 44 | | let opCall = opMethod <@ fun (t: obj) -> (Dlr.call t) : obj @> |
| | | 45 | | let opApply = opMethod <@ fun (a: obj) (t: obj) -> (Dlr.apply a t) : obj @> |
| | | 46 | | let opNamed = opMethod <@ fun (r: obj) -> Dlr.named r @> |
| | | 47 | | let opNamedOf = opMethod <@ fun (l: (string * obj) list) -> Dlr.namedOf l @> |
| | | 48 | | let opArgsOf = opMethod <@ fun (l: obj list) -> Dlr.argsOf l @> |
| | | 49 | | /// `Dlr.new'<T>(a, b, …)`: the type and the arguments (each unboxed to its static type). |
| | | 50 | | let (|New|_|) (e: Expr) = |
| | 394979 | 51 | | match e with |
| | 60070 | 52 | | | Call(None, mi, args) when mi.DeclaringType = typeof<Dlr> && mi.Name = "new'" -> |
| | 2160 | 53 | | Some(mi.GetGenericArguments().[0], [ for a in args -> match a with Coerce(inner, t) when t = typeof<obj> -> |
| | 394671 | 54 | | | _ -> None |
| | | 55 | | let opCast = opMethod <@ fun (v: obj) -> Dlr.cast<obj> v @> |
| | | 56 | | let opImplicit = opMethod <@ fun (v: obj) -> (Dlr.implicit v) : obj @> |
| | | 57 | | let opGet = opMethod <@ fun (n: string) (t: obj) -> (Dlr.get n t) : obj @> |
| | | 58 | | let opSet = opMethod <@ fun (n: string) (v: obj) (t: obj) -> Dlr.set n v t @> |
| | | 59 | | let opAddAssign = opMethod <@ fun (n: string) (v: obj) (t: obj) -> Dlr.addAssign n v t @> |
| | | 60 | | let opSubtractAssign = opMethod <@ fun (n: string) (v: obj) (t: obj) -> Dlr.subtractAssign n v t @> |
| | | 61 | | let opInvoke = opMethod <@ fun (n: string) (a: obj) (t: obj) -> (Dlr.invoke n a t) : obj @> |
| | | 62 | | let unaryOps = |
| | | 63 | | dict [ |
| | | 64 | | opMethod <@ fun (v: obj) -> (Dlr.neg v) : obj @>, ExpressionType.Negate |
| | | 65 | | opMethod <@ fun (v: obj) -> (Dlr.not v) : obj @>, ExpressionType.Not |
| | | 66 | | opMethod <@ fun (v: obj) -> (Dlr.complement v) : obj @>, ExpressionType.OnesComplement |
| | | 67 | | ] |
| | | 68 | | let forEach = opMethod <@ fun (items: seq<obj>) (body: Func<obj, unit>) -> DlrRuntime.forEach items body @> |
| | | 69 | | let whileLoop = opMethod <@ fun (guard: Func<bool>) (body: Func<unit>) -> DlrRuntime.whileLoop guard body @> |
| | | 70 | | let forRange = opMethod <@ fun (low: int) (high: int) (body: Func<int, unit>) -> DlrRuntime.forRange low high body @ |
| | | 71 | | let tryWith = opMethod <@ fun (body: Func<obj>) (handler: Func<exn, obj>) -> DlrRuntime.tryWith body handler @> |
| | | 72 | | let tryFinally = opMethod <@ fun (body: Func<obj>) (fin: Func<unit>) -> DlrRuntime.tryFinally body fin @> |
| | | 73 | | let rethrow = opMethod <@ fun (e: exn) -> (DlrRuntime.rethrow e : obj) @> |
| | | 74 | | let reraiseMethod = typeof<unit>.Assembly.GetType("Microsoft.FSharp.Core.Operators").GetMethod("Reraise") |
| | | 75 | | let using = opMethod <@ fun (r: IDisposable) (body: Func<IDisposable, obj>) -> DlrRuntime.using r body @> |
| | | 76 | | let opItem = opMethod <@ fun (i: obj) (t: obj) -> (Dlr.item i t) : obj @> |
| | | 77 | | let opSetItem = opMethod <@ fun (i: obj) (v: obj) (t: obj) -> Dlr.setItem i v t @> |
| | | 78 | | |
| | | 79 | | let binaryOps = |
| | | 80 | | dict [ |
| | | 81 | | opMethod <@ fun (l: obj) (r: obj) -> (l ?%? r) : obj @>, ExpressionType.Modulo |
| | | 82 | | opMethod <@ fun (l: obj) (r: obj) -> (l ?*? r) : obj @>, ExpressionType.Multiply |
| | | 83 | | opMethod <@ fun (l: obj) (r: obj) -> (l ?+? r) : obj @>, ExpressionType.Add |
| | | 84 | | opMethod <@ fun (l: obj) (r: obj) -> (l ?-? r) : obj @>, ExpressionType.Subtract |
| | | 85 | | opMethod <@ fun (l: obj) (r: obj) -> (l ?/? r) : obj @>, ExpressionType.Divide |
| | | 86 | | opMethod <@ fun (l: obj) (r: obj) -> (l ?&&&? r) : obj @>, ExpressionType.And |
| | | 87 | | opMethod <@ fun (l: obj) (r: obj) -> (l ?|||? r) : obj @>, ExpressionType.Or |
| | | 88 | | opMethod <@ fun (l: obj) (r: obj) -> (l ?^^^? r) : obj @>, ExpressionType.ExclusiveOr |
| | | 89 | | opMethod <@ fun (l: obj) (r: obj) -> (l ?<<<? r) : obj @>, ExpressionType.LeftShift |
| | | 90 | | opMethod <@ fun (l: obj) (r: obj) -> (l ?>>>? r) : obj @>, ExpressionType.RightShift |
| | | 91 | | opMethod <@ fun (l: obj) (r: obj) -> l ?<=? r @>, ExpressionType.LessThanOrEqual |
| | | 92 | | opMethod <@ fun (l: obj) (r: obj) -> l ?<>? r @>, ExpressionType.NotEqual |
| | | 93 | | opMethod <@ fun (l: obj) (r: obj) -> l ?<? r @>, ExpressionType.LessThan |
| | | 94 | | opMethod <@ fun (l: obj) (r: obj) -> l ?=? r @>, ExpressionType.Equal |
| | | 95 | | opMethod <@ fun (l: obj) (r: obj) -> l ?>? r @>, ExpressionType.GreaterThan |
| | | 96 | | opMethod <@ fun (l: obj) (r: obj) -> l ?>=? r @>, ExpressionType.GreaterThanOrEqual |
| | | 97 | | ] |
| | | 98 | | |
| | | 99 | | /// A literal `[ typeof<A>; typeof<B>; … ]`. |
| | | 100 | | let rec (|TypeOfList|_|) (e: Expr) = |
| | 17458 | 101 | | match e with |
| | 56 | 102 | | | NewUnionCase(empty, []) when empty.Name = "Empty" -> Some [] |
| | 96 | 103 | | | NewUnionCase(cons, [ Call(None, mi, []); TypeOfList rest ]) when cons.Name = "Cons" && mi.Name = "TypeOf" && m |
| | 32 | 104 | | Some(mi.GetGenericArguments().[0] :: rest) |
| | 17402 | 105 | | | _ -> None |
| | | 106 | | |
| | | 107 | | /// The explicit type arguments of a call: known at translation time (`Dlr.typeArgs<A, B>()`, |
| | | 108 | | /// or `Dlr.typeArgsOf` with a literal list of `typeof`s, which folds to the same), or an |
| | | 109 | | /// expression evaluated per call (`Dlr.typeArgsOf ts`), which keys a SiteCache like a |
| | | 110 | | /// computed name does. |
| | | 111 | | type TypeArgsSpec = |
| | | 112 | | | StaticTypes of Type list |
| | | 113 | | | RuntimeTypes of Expr |
| | | 114 | | |
| | | 115 | | let (|TypeArgs|_|) (e: Expr) = |
| | 137652 | 116 | | match e with |
| | 1946 | 117 | | | Call(None, mi, []) when mi.DeclaringType = typeof<Dlr> && mi.Name = "typeArgs" -> Some(StaticTypes(List.ofArra |
| | 64 | 118 | | | Call(None, mi, [ TypeOfList ts ]) when mi.DeclaringType = typeof<Dlr> && mi.Name = "typeArgsOf" -> Some(Static |
| | 5740 | 119 | | | Call(None, mi, [ types ]) when mi.DeclaringType = typeof<Dlr> && mi.Name = "typeArgsOf" -> Some(RuntimeTypes t |
| | 137560 | 120 | | | _ -> None |
| | | 121 | | |
| | | 122 | | /// `Static<T>.Overloads` as a target: the type. |
| | | 123 | | let (|StaticTarget|_|) (e: Expr) = |
| | 141743 | 124 | | match e with |
| | 13600 | 125 | | | PropertyGet(None, pi, []) when pi.Name = "Overloads" && pi.DeclaringType.IsGenericType && pi.DeclaringType.Get |
| | 144 | 126 | | Some(pi.DeclaringType.GetGenericArguments().[0]) |
| | 141599 | 127 | | | _ -> None |
| | | 128 | | |
| | | 129 | | let (|Op|_|) (def: Reflection.MethodInfo) (e: Expr) = |
| | 6267896 | 130 | | match e with |
| | 995196 | 131 | | | Call(None, mi, args) when genericDef mi = def -> Some args |
| | 6228709 | 132 | | | _ -> None |
| | | 133 | | |
| | | 134 | | /// `Dlr.namedOf pairs`: the list expression. |
| | | 135 | | let (|NamedOf|_|) (e: Expr) = |
| | 12026 | 136 | | match e with |
| | 12658 | 137 | | | Op opNamedOf [ pairs ] -> Some pairs |
| | 11394 | 138 | | | _ -> None |
| | | 139 | | |
| | | 140 | | /// `Dlr.argsOf values`: the list expression. |
| | | 141 | | let (|ArgsOf|_|) (e: Expr) = |
| | 11214 | 142 | | match e with |
| | 11894 | 143 | | | Op opArgsOf [ values ] -> Some values |
| | 10534 | 144 | | | _ -> None |
| | | 145 | | |
| | | 146 | | /// Either splat marker. |
| | 6620 | 147 | | let isSplat (e: Expr) = match e with NamedOf _ | ArgsOf _ -> true | _ -> false |
| | | 148 | | |
| | | 149 | | /// `Dlr.out` / `Dlr.outAs<'T> ()`: an out argument, its value returned in the result tuple; with |
| | | 150 | | /// the type the out states (`outAs`), or None for the result's shape to infer. |
| | | 151 | | let (|OutMarker|_|) (e: Expr) = |
| | 147913 | 152 | | match e with |
| | 23516 | 153 | | | PropertyGet(None, p, []) when p.DeclaringType = typeof<Dlr> && p.Name = "out" -> Some None |
| | 2246 | 154 | | | Call(None, mi, []) when mi.DeclaringType = typeof<Dlr> && mi.Name = "outAs" -> Some(Some(mi.GetGenericArgument |
| | 142437 | 155 | | | _ -> None |
| | | 156 | | |
| | | 157 | | /// `Dlr.ref v`: a ref argument over the variable `v`. |
| | | 158 | | let (|RefMarker|_|) (e: Expr) = |
| | 143439 | 159 | | match e with |
| | 6838 | 160 | | | Call(None, mi, [ v ]) when mi.DeclaringType = typeof<Dlr> && mi.Name = "ref" -> Some v |
| | 143229 | 161 | | | _ -> None |
| | | 162 | | |
| | 11488 | 163 | | let isByRefMarker (e: Expr) = match e with OutMarker _ | RefMarker _ -> true | _ -> false |
| | | 164 | | let unboxTo = opMethod <@ fun (o: obj) -> unbox<int> o @> |
| | | 165 | | |
| | | 166 | | let (|UnaryOp|_|) (e: Expr) = |
| | 130883 | 167 | | match e with |
| | | 168 | | | Call(None, mi, [ v ]) -> |
| | 4974 | 169 | | match unaryOps.TryGetValue(genericDef mi) with |
| | 20 | 170 | | | true, op -> Some(op, v) |
| | 4954 | 171 | | | _ -> None |
| | 125909 | 172 | | | _ -> None |
| | | 173 | | |
| | | 174 | | let (|BinaryOp|_|) (e: Expr) = |
| | 131121 | 175 | | match e with |
| | | 176 | | | Call(None, mi, [ l; r ]) -> |
| | 12166 | 177 | | match binaryOps.TryGetValue(genericDef mi) with |
| | 238 | 178 | | | true, op -> Some(op, l, r) |
| | 11928 | 179 | | | _ -> None |
| | 118955 | 180 | | | _ -> None |
| | | 181 | | |
| | | 182 | | let (|Literal|_|) (e: Expr) = |
| | 16743 | 183 | | match e with |
| | 14127 | 184 | | | Value(o, _) -> Some o |
| | 2616 | 185 | | | _ -> None |
| | | 186 | | |
| | | 187 | | |
| | | 188 | | /// Strips the boxing F# inserts on the way to an `obj` parameter, so the binder can see the |
| | | 189 | | /// real static type. |
| | | 190 | | let (|Unboxed|) (e: Expr) = |
| | 36447 | 191 | | match e with |
| | 376 | 192 | | | Coerce(inner, t) when t = typeof<obj> -> inner |
| | 36259 | 193 | | | _ -> e |
| | | 194 | | |
| | | 195 | | /// `Dlr.named {| a = x; b = y |}`: the field names and values. F# evaluates the fields in |
| | | 196 | | /// source order through `let` temporaries and then builds the record in its own (sorted) |
| | | 197 | | /// field order, so the temporaries come back as bindings to wrap around the call. |
| | | 198 | | let (|NamedRecord|_|) (e: Expr) = |
| | | 199 | | let rec peel (bindings: (Var * Expr) list) (e: Expr) = |
| | 500 | 200 | | match e with |
| | 36 | 201 | | | Let(v, value, body) -> peel ((v, value) :: bindings) body |
| | 696 | 202 | | | Op opNamed [ inner ] -> peel bindings inner |
| | | 203 | | | NewRecord(recordType, values) -> |
| | 224 | 204 | | let fields = FSharpType.GetRecordFields recordType |
| | 1320 | 205 | | Some(List.rev bindings, List.zip [ for f in fields -> f.Name ] values) |
| | 8 | 206 | | | other -> unsupported "Dlr.named applied to anything but an anonymous record literal" other |
| | 13602 | 207 | | match e with |
| | 13834 | 208 | | | Op opNamed _ -> peel [] e |
| | 13370 | 209 | | | _ -> None |
| | | 210 | | |
| | | 211 | | /// The compiler eta-expands a dynamic member used as a statement: |
| | | 212 | | /// `let clo = x?Foo in fun a -> clo a` applied to `()`. Fold it back to `x?Foo`. |
| | | 213 | | let rec (|EtaReduced|) (e: Expr) = |
| | 14264 | 214 | | match e with |
| | 0 | 215 | | | Let(v, value, Lambda(x, Application(Var v', Var x'))) when v = v' && x = x' -> value |
| | 14264 | 216 | | | _ -> e |
| | | 217 | | |
| | | 218 | | /// `let a0 = x.0 in … let an = x.n in v (a0, …, an)`: the lambda body of the tupled |
| | | 219 | | /// eta-expansion the compiler makes of a call with a tuple of arguments on a target whose |
| | | 220 | | /// static type is not `obj` — a struct or class expression, a typed variable — (`let clo = |
| | | 221 | | /// (f ())?M in fun tupledArg -> …` applied to the tuple). |
| | | 222 | | let retuples (v: Var) (x: Var) (body: Expr) = |
| | | 223 | | let rec peel (elements: Var list) (e: Expr) = |
| | 60 | 224 | | match e with |
| | 96 | 225 | | | Let(a, TupleGet(Var x', i), rest) when x' = x && i = elements.Length -> peel (elements @ [ a ]) rest |
| | 12 | 226 | | | Application(Var v', NewTuple items) when v' = v -> |
| | 48 | 227 | | items.Length = elements.Length && List.forall2 (fun (item: Expr) (a: Var) -> item = Expr.Var a) items el |
| | 16 | 228 | | | _ -> false |
| | 28 | 229 | | peel [] body |
| | | 230 | | |
| | | 231 | | /// One of the member operations, whichever way it was spelled: `x?Name` / `(?) x name` / |
| | | 232 | | /// `Dlr.get name x`, those applied to arguments (`x?Name(a)`, `(Dlr.get name x)(a)`) or |
| | | 233 | | /// `Dlr.invoke name a x`, and `x?Name <- v` / `Dlr.set name v x`. Target, name |
| | | 234 | | /// expression, and the argument expression (for an invocation) or value (for a set). |
| | | 235 | | type MemberOp = |
| | | 236 | | | GetMember of target: Expr * name: Expr |
| | | 237 | | | InvokeMember of target: Expr * name: Expr * args: Expr |
| | | 238 | | | SetMember of target: Expr * name: Expr * value: Expr |
| | | 239 | | |
| | | 240 | | let (|MemberOp|_|) (e: Expr) = |
| | 825493 | 241 | | match e with |
| | 13664 | 242 | | | Application(EtaReduced(Op opDynamic [ Unboxed target; name ]), args) -> Some(InvokeMember(target, name, args)) |
| | 849590 | 243 | | | Op opDynamic [ Unboxed target; name ] -> Some(GetMember(target, name)) |
| | 792768 | 244 | | | Op opDynamicAssign [ Unboxed target; name; value ] -> Some(SetMember(target, name, value)) |
| | 4108 | 245 | | | Application(EtaReduced(Op opGet [ name; Unboxed target ]), args) -> Some(InvokeMember(target, name, args)) |
| | 791124 | 246 | | | Op opGet [ name; Unboxed target ] -> Some(GetMember(target, name)) |
| | 392791 | 247 | | | Op opInvoke [ name; args; Unboxed target ] -> Some(InvokeMember(target, name, args)) |
| | 392707 | 248 | | | Op opSet [ name; value; Unboxed target ] -> Some(SetMember(target, name, value)) |
| | 392683 | 249 | | | _ -> None |
| | | 250 | | |
| | | 251 | | /// `x?Foo()` applies unit; `x?Foo(a, b)` applies a tuple; `x?Foo(a)` applies one value. As in |
| | | 252 | | /// F#'s own method calls (`w.Add args` with `args: int * int`), an expression whose static |
| | | 253 | | /// type is a reference tuple is several arguments too: it is bound once and split with |
| | | 254 | | /// `TupleGet`, each element keeping its static type. A struct tuple is one value, as in F#; |
| | | 255 | | /// `box t` passes a tuple as one dynamic argument. Returns the binding, if any, and the items. |
| | | 256 | | let splitArgs (e: Expr) : (Var * Expr) list * Expr list = |
| | 6800 | 257 | | match e with |
| | | 258 | | // `()`, or a `unit`-typed variable (a generic parameter instantiated to unit, `let args = ()`): |
| | | 259 | | // no arguments, and nothing to evaluate. |
| | 1704 | 260 | | | Value(_, t) when t = typeof<unit> -> [], [] |
| | 255 | 261 | | | Var v when v.Type = typeof<unit> -> [], [] |
| | | 262 | | // A unit-valued expression: evaluated for its effect, and no arguments. A void call |
| | | 263 | | // cannot be let-bound (the converter has no value for it), so `()` follows it. |
| | 3205 | 264 | | | e when e.Type = typeof<unit> -> [ Var("effect", typeof<unit>), Expr.Sequential(e, Expr.Value(())) ], [] |
| | 1974 | 265 | | | NewTuple items -> [], items |
| | 1207 | 266 | | | _ when FSharpType.IsTuple e.Type && not e.Type.IsValueType -> |
| | 28 | 267 | | let v = Var("args", e.Type) |
| | 168 | 268 | | [ v, e ], [ for i in 0 .. FSharpType.GetTupleElements(e.Type).Length - 1 -> Expr.TupleGet(Expr.Var v, i) ] |
| | 1147 | 269 | | | single -> [], [ single ] |
| | | 270 | | |
| | | 271 | | /// Whether evaluating `e` has no effect and no order to keep: an immutable variable, a |
| | | 272 | | /// literal, a lambda, a read-only field, a tuple or coercion of such. A mutable (a captured |
| | | 273 | | /// `let mutable`, a mutable field) is not: an argument may assign it. Anything else is bound |
| | | 274 | | /// in source order by `sequenced`. |
| | | 275 | | let rec isPure (e: Expr) = |
| | 3478 | 276 | | match e with |
| | 792 | 277 | | | Var v -> not v.IsMutable |
| | 1378 | 278 | | | Value _ | Lambda _ | StaticTarget _ -> true |
| | 0 | 279 | | | FieldGet(None, f) -> f.IsInitOnly || f.IsLiteral |
| | 0 | 280 | | | FieldGet(Some inner, f) -> f.IsInitOnly && isPure inner |
| | 64 | 281 | | | Coerce(inner, _) | TupleGet(inner, _) -> isPure inner |
| | 0 | 282 | | | NewTuple items -> List.forall isPure items |
| | 1244 | 283 | | | _ -> false |
| | | 284 | | |
| | | 285 | | /// Whether a form's arguments make it hoist something ahead of its site call: a `Dlr.named` |
| | | 286 | | /// record's field temporaries, a splat list, a tuple bound by `splitArgs`. |
| | | 287 | | let hoists (tupleBindings: (Var * Expr) list) (argExprs: Expr list) = |
| | 1053 | 288 | | not tupleBindings.IsEmpty |
| | 9158 | 289 | | || argExprs |> List.exists (fun a -> match a with NamedOf _ | ArgsOf _ -> true | NamedRecord(lets, _) -> not let |
| | | 290 | | |
| | | 291 | | /// C#'s evaluation order — the target, then the arguments left to right — kept where a form |
| | | 292 | | /// hoists something ahead of its site call (`hoists`), which would otherwise run first: |
| | | 293 | | /// every impure expression is bound to a variable in source order, so the hoisted ones take |
| | | 294 | | /// their own place. The tuple of `splitArgs` goes after the target, where the arguments are; |
| | | 295 | | /// a computed name or type list (`keys`) between the target and the arguments, where |
| | | 296 | | /// `(?) x name args` writes them. Returns the bindings, the variables to add to the bound |
| | | 297 | | /// set, and the target, keys and arguments rewritten over the variables. |
| | | 298 | | let sequenced (target: Expr option) (keys: Expr list) (tupleBindings: (Var * Expr) list) (argExprs: Expr list) = |
| | 1590 | 299 | | let bindings = ResizeArray<Var * Expr>() |
| | | 300 | | let place (name: string) (e: Expr) = |
| | 5444 | 301 | | if isPure e then e |
| | | 302 | | else |
| | 1228 | 303 | | let v = Var(name, e.Type) |
| | 1228 | 304 | | bindings.Add((v, e)) |
| | 1228 | 305 | | Expr.Var v |
| | 2383 | 306 | | let target' = target |> Option.map (place "target") |
| | 2461 | 307 | | let keys' = keys |> List.mapi (fun i k -> place (sprintf "key%d" i) k) |
| | 1590 | 308 | | bindings.AddRange tupleBindings |
| | | 309 | | let args' = |
| | 2383 | 310 | | argExprs |> List.mapi (fun i a -> |
| | 3226 | 311 | | match a with |
| | 1590 | 312 | | // The record's temporaries at the record's place; the record itself then holds |
| | 1590 | 313 | | // only variables and pure values. |
| | 44 | 314 | | | NamedRecord(lets, _) when not lets.IsEmpty -> |
| | 1590 | 315 | | let rec strip (e: Expr) = |
| | 60 | 316 | | match e with |
| | 20 | 317 | | | Let(_, _, body) -> strip body |
| | 20 | 318 | | | Call(None, mi, [ inner ]) -> Expr.Call(mi, [ strip inner ]) |
| | 20 | 319 | | | e -> e |
| | 20 | 320 | | bindings.AddRange lets |
| | 20 | 321 | | strip a |
| | 24 | 322 | | | NamedRecord _ -> a |
| | 514 | 323 | | | Call(None, mi, [ list ]) when isSplat a -> Expr.Call(mi, [ place (sprintf "list%d" i) list ]) |
| | 1590 | 324 | | // A byref marker stays where it is: the translator reads a ref's variable at the |
| | 1590 | 325 | | // call, after every other argument (a C# ref is a reference: the callee sees each |
| | 1590 | 326 | | // argument's write to it). |
| | 1486 | 327 | | | OutMarker _ | RefMarker _ -> a |
| | 3064 | 328 | | | a -> place (sprintf "arg%d" i) a) |
| | 3176 | 329 | | let bound = bindings |> Seq.map fst |> Set.ofSeq |
| | 1590 | 330 | | List.ofSeq bindings, bound, target', keys', args' |
| | | 331 | | |
| | | 332 | | /// The definition of a let-bound variable somewhere in `e` (quotation Vars are identity-based, |
| | | 333 | | /// so shadowing is not a concern). A `let rec` one is its whole group, `let rec … in v`: its |
| | | 334 | | /// own references stay bound to it rather than recovered again (#198). |
| | | 335 | | let rec letDefinition (v: Var) (e: Expr) : Expr option = |
| | 1676004 | 336 | | match e with |
| | 127560 | 337 | | | Let(v', def, _) when v' = v -> Some def |
| | 724 | 338 | | | LetRecursive(bindings, _) when bindings |> List.exists (fun (v', _) -> v' = v) -> Some(Expr.LetRecursive(bindi |
| | 398194 | 339 | | | ShapeVar _ -> None |
| | 348183 | 340 | | | ShapeLambda(_, body) -> letDefinition v body |
| | 1378763 | 341 | | | ShapeCombination(_, args) -> args |> List.tryPick (letDefinition v) |
| | | 342 | | |
| | | 343 | | /// The argument a parameter of a let-bound local function takes, when the member body |
| | | 344 | | /// applies that function exactly once — or of a lambda applied on the spot, |
| | | 345 | | /// `(fun k -> …) 1`: the optimizer inlines such a function at its call site, so its |
| | | 346 | | /// parameters become that call's arguments and are never captured. |
| | | 347 | | let parameterArgument (v: Var) (memberBody: Expr) : Expr option = |
| | | 348 | | let rec lambdaParams (e: Expr) = |
| | 56668 | 349 | | match e with |
| | 44084 | 350 | | | Lambda(p, body) -> let ps, inner = lambdaParams body in p :: ps, inner |
| | 34626 | 351 | | | _ -> [], e |
| | | 352 | | let rec applications (f: Var) (e: Expr) : Expr list list = |
| | | 353 | | // Full application chains f a1 a2 … of `f`, innermost first. |
| | | 354 | | let rec chain (e: Expr) (acc: Expr list) = |
| | 168 | 355 | | match e with |
| | 16 | 356 | | | Application(inner, arg) -> chain inner (arg :: acc) |
| | 56 | 357 | | | Var f' when f' = f -> Some acc |
| | 144 | 358 | | | _ -> None |
| | 152 | 359 | | match chain e [] with |
| | 16 | 360 | | | Some args when not args.IsEmpty -> [ args ] |
| | | 361 | | | _ -> |
| | 144 | 362 | | match e with |
| | 40 | 363 | | | ShapeVar _ -> [] |
| | 32 | 364 | | | ShapeLambda(_, body) -> applications f body |
| | 72 | 365 | | | ShapeCombination(_, args) -> args |> List.collect (applications f) |
| | | 366 | | /// `(fun p1 p2 -> body) a1 a2`: the lambda chain and its arguments, in order. |
| | | 367 | | let rec applied (e: Expr) (acc: Expr list) = |
| | 42404 | 368 | | match e with |
| | 21803 | 369 | | | Application(inner, arg) -> applied inner (arg :: acc) |
| | 29580 | 370 | | | Lambda _ when not acc.IsEmpty -> Some(e, acc) |
| | 5811 | 371 | | | _ -> None |
| | | 372 | | /// The argument `v` takes in a lambda applied on the spot, if `e` is one binding `v`. |
| | | 373 | | let appliedArgument (e: Expr) : Expr option = |
| | 20601 | 374 | | match applied e [] with |
| | | 375 | | | Some(f, args) -> |
| | 14790 | 376 | | let ps, _ = lambdaParams f |
| | 14790 | 377 | | match List.tryFindIndex ((=) v) ps with |
| | 17016 | 378 | | | Some i when i < args.Length -> Some args.[i] |
| | 6282 | 379 | | | _ -> None |
| | 5811 | 380 | | | None -> None |
| | | 381 | | let rec search (e: Expr) : Expr option = |
| | 273420 | 382 | | match e with |
| | 39656 | 383 | | | Let(f, def, rest) when (let ps, _ = lambdaParams def in List.contains v ps) -> |
| | 8 | 384 | | let ps, _ = lambdaParams def |
| | 8 | 385 | | let index = List.findIndex ((=) v) ps |
| | 8 | 386 | | match applications f rest with |
| | 16 | 387 | | | [ args ] when args.Length > index -> Some args.[index] |
| | 0 | 388 | | | [] -> None |
| | 0 | 389 | | | _ -> None |
| | 20601 | 390 | | | Application _ when (appliedArgument e).IsSome -> appliedArgument e |
| | 59647 | 391 | | | ShapeVar _ -> None |
| | 55895 | 392 | | | ShapeLambda(_, body) -> search body |
| | 153796 | 393 | | | ShapeCombination(_, args) -> args |> List.tryPick search |
| | 4481 | 394 | | search memberBody |
| | | 395 | | |
| | | 396 | | // `|>` is inlined inside a quotation literal, so these come from reflection instead. |
| | | 397 | | let fsharpOperators = typeof<obj list>.Assembly.GetType("Microsoft.FSharp.Core.Operators") |
| | | 398 | | let pipeRight = fsharpOperators.GetMethod("op_PipeRight") |
| | | 399 | | let pipeLeft = fsharpOperators.GetMethod("op_PipeLeft") |
| | | 400 | | |
| | | 401 | | /// `x |> f` in a reflected body is `op_PipeRight(x, let name = "A" in fun target -> …)`, and a |
| | | 402 | | /// curried marker applied to its arguments is `Application(Lambda(name, Lambda(target, …)), …)`. |
| | | 403 | | /// Apply such functions to their arguments and inline `let`s of literals and variables, so |
| | | 404 | | /// `w |> Dlr.get "A"` becomes the plain `Dlr.get "A" w` call the member-op patterns recognise, |
| | | 405 | | /// with the name a literal and a tuple argument still a tuple. An argument is substituted for |
| | | 406 | | /// its parameter only when that cannot change what runs: it is a variable or a literal, or it |
| | | 407 | | /// is used exactly once and not under a lambda (where it would run per invocation). Otherwise |
| | | 408 | | /// it is let-bound, so it is evaluated once — including when the parameter is never used. |
| | | 409 | | let rec normalize (e: Expr) : Expr = |
| | | 410 | | /// Occurrences of `v`, with any occurrence under a lambda counted as many. |
| | | 411 | | let rec occurrences (v: Var) (e: Expr) = |
| | 26612 | 412 | | match e with |
| | 11622 | 413 | | | Var v' when v' = v -> 1 |
| | 5038 | 414 | | | ShapeVar _ -> 0 |
| | 4328 | 415 | | | ShapeLambda(_, body) -> occurrences v body * 2 |
| | 20931 | 416 | | | ShapeCombination(_, args) -> args |> List.sumBy (occurrences v) |
| | | 417 | | /// The same, but lambdas on the spine of a curried function (`fun a -> fun b -> …`, each |
| | | 418 | | /// applied exactly once by the next argument) do not count as "under a lambda". |
| | | 419 | | let rec spineOccurrences (v: Var) (e: Expr) = |
| | 2078 | 420 | | match e with |
| | 182 | 421 | | | Lambda(_, body) -> spineOccurrences v body |
| | 1896 | 422 | | | _ -> occurrences v e |
| | 8352 | 423 | | let pure' (x: Expr) = match x with Var v -> not v.IsMutable | Value _ -> true | _ -> false |
| | | 424 | | let rec apply (f: Expr) (x: Expr) : Expr = |
| | 3954 | 425 | | match f with |
| | 760 | 426 | | | Let(v, value, body) -> Expr.Let(v, value, apply body x) |
| | | 427 | | | Lambda(p, body) -> |
| | 22258 | 428 | | if pure' x || spineOccurrences p body = 1 then body.Substitute(fun v -> if v = p then Some x else None) |
| | | 429 | | // A `unit` argument may compile to a void site call, which cannot be let-bound: |
| | | 430 | | // run it, then the body with `()` for the parameter. |
| | 724 | 431 | | elif x.Type = typeof<unit> then Expr.Sequential(x, body.Substitute(fun v -> if v = p then Some(Expr.Valu |
| | 708 | 432 | | else Expr.Let(p, x, body) |
| | 0 | 433 | | | _ -> Expr.Application(f, x) |
| | | 434 | | let applied (f: Expr) (x: Expr) = |
| | 7393 | 435 | | match normalize f, normalize x with |
| | 3194 | 436 | | | (Lambda _ | Let _ as f), x -> normalize (apply f x) |
| | 4199 | 437 | | | f, x -> Expr.Application(f, x) |
| | 263884 | 438 | | match e with |
| | 265418 | 439 | | | Op pipeRight [ x; f ] -> applied f x |
| | 262354 | 440 | | | Op pipeLeft [ f; x ] -> applied f x |
| | | 441 | | // The tupled eta-expansion of a member call: back to the member applied to the tuple, |
| | | 442 | | // before the tuple would be let-bound under the lambda and its markers lost. |
| | 40 | 443 | | | Application(Let(v, value, Lambda(x, body)), arg) when retuples v x body -> applied value arg |
| | 5827 | 444 | | | Application(f, x) -> applied f x |
| | | 445 | | // A `let` of a literal or an immutable variable is inlined; a snapshot of a mutable |
| | | 446 | | // (`let y = n` with `n` mutable) is not, since `n` may change before `y` is used. |
| | 14180 | 447 | | | Let(v, (Value _ | Var _ as value), body) when not v.IsMutable && pure' value -> normalize (body.Substitute(fun |
| | | 448 | | // The eta-expanded statement form `let clo = x?Foo in clo ()` once its lambda is applied. |
| | 32 | 449 | | | Let(v, value, Application(Var v', arg)) when v = v' -> applied value arg |
| | | 450 | | // A parameterless delegate literal (`Func<int>(fun () -> 7)`, `Action(fun () -> …)`): F# |
| | | 451 | | // quotes it with no parameter and a bare body, a node FSharp.Core takes apart as the lambda |
| | | 452 | | // `fun () -> body` but rebuilds only from the bare body, so no rewrite can pass it through |
| | | 453 | | // (#156). It becomes `ParameterlessLiteral<D, R>.Of (fun () -> body)`, an ordinary call |
| | | 454 | | // that makes the delegate by its own type. |
| | | 455 | | | NewDelegate(t, [], body) -> |
| | 136 | 456 | | let body = normalize body |
| | 136 | 457 | | let thunk = Expr.Lambda(Var("unitVar", typeof<unit>), body) |
| | 136 | 458 | | let literal = typedefof<ParameterlessLiteral<_, _>>.MakeGenericType(t, body.Type) |
| | 136 | 459 | | Expr.Call(literal.GetMethod("Of"), [ thunk ]) |
| | 255381 | 460 | | | _ -> Quotation.rebuild normalize e |