| | | 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 | | /// One block's translation context (`Block`) and what every rewrite of it shares: where its |
| | | 14 | | /// free variables come from (`Captures`), the builder's own members (`Plumbing`), and the |
| | | 15 | | /// helpers they use. |
| | | 16 | | module internal TranslateBlock = |
| | | 17 | | open TranslatePatterns |
| | | 18 | | open SiteHoisting |
| | | 19 | | |
| | | 20 | | /// What every part of the translation of one block needs: where it is (the builder and the |
| | | 21 | | /// member it sits in) and where its values come from (the state machine struct or the Delay |
| | | 22 | | /// closure — the same contract: the captured variables are its fields, by name). |
| | | 23 | | type Block = |
| | | 24 | | { BuilderType: Type |
| | | 25 | | /// Type declaring the enclosing member: the binder's accessibility context, as in C#. |
| | | 26 | | Context: Type |
| | | 27 | | /// The enclosing member's whole reflected body, for values the optimizer inlined. |
| | | 28 | | MemberBody: Expr |
| | | 29 | | /// The compiler-generated container: the state machine struct, or the Delay closure class. |
| | | 30 | | ClosureType: Type |
| | | 31 | | /// The compiled delegate's one parameter: the struct itself (a copy of the machine the |
| | | 32 | | /// reader is handed by reference), or the closure as `obj`. |
| | | 33 | | Closure: Var |
| | | 34 | | /// The container's fields, named after the captured variables. |
| | | 35 | | Fields: Collections.Generic.IDictionary<string, Reflection.FieldInfo> |
| | | 36 | | /// The compiled block's name, `dlr__Program_fs@7`: its stack frame's name. |
| | | 37 | | Name: string |
| | | 38 | | /// How many nested lambdas of each kind (`for`, `try`, `fun`, …) have been named so far. |
| | | 39 | | Names: Collections.Generic.Dictionary<string, int> |
| | | 40 | | /// Names two of the variables the block reaches share (#196): its free variables, and |
| | | 41 | | /// those of the definitions it recovers for what the optimizer inlined (`Captures.reached`). |
| | | 42 | | Ambiguous: Set<string> |
| | | 43 | | /// Aliases (`let x = y` of an immutable `y`, `let x = 1`) the block reaches only through |
| | | 44 | | /// a recovered definition: substituted, never a field, whatever field shares the name. |
| | | 45 | | Substituted: Set<Var> } |
| | | 46 | | /// The name for this block's next compiled part of `kind`, for its stack frame: F#'s |
| | | 47 | | /// closure style, `dlr__Program_fs@7-for`, then `-for-2`, `-for-3` in order. |
| | | 48 | | member this.NameFor (kind: string) = |
| | 24762 | 49 | | let n = (match this.Names.TryGetValue kind with | true, n -> n | _ -> 0) + 1 |
| | 8254 | 50 | | this.Names.[kind] <- n |
| | 16508 | 51 | | if n = 1 then sprintf "%s-%s" this.Name kind else sprintf "%s-%s-%d" this.Name kind n |
| | | 52 | | member this.Self = |
| | 8417 | 53 | | if this.ClosureType.IsValueType then Expr.Var this.Closure |
| | 2953 | 54 | | else Expr.Coerce(Expr.Var this.Closure, this.ClosureType) |
| | 4554 | 55 | | member this.Convert (resultType: Type) (e: Expr) = Binders.convert this.Context resultType e |
| | | 56 | | |
| | | 57 | | /// The builder's members type as `ResumableCode<'D, 'R>` — the shape the compiler's state |
| | | 58 | | /// machine needs — where the translation produces the plain `'R` value. `codeType` is what |
| | | 59 | | /// such an expression's type becomes; an expression typed that way that is not a builder call |
| | | 60 | | /// (the compiler's default value in an unmatched `try … with` arm) is retyped to it so the |
| | | 61 | | /// rebuilt tree is consistent. |
| | | 62 | | let isCode (t: Type) = |
| | 4062 | 63 | | t.IsGenericType && t.GetGenericTypeDefinition() = typedefof<Microsoft.FSharp.Core.CompilerServices.ResumableCode |
| | 1616 | 64 | | let codeType (t: Type) = if isCode t then t.GetGenericArguments().[1] else t |
| | | 65 | | let defaultOf (t: Type) = |
| | 64 | 66 | | if t = typeof<unit> then Expr.Value(()) |
| | 24 | 67 | | elif t.IsValueType then Expr.DefaultValue t |
| | 8 | 68 | | else Expr.Value(null, t) |
| | | 69 | | |
| | | 70 | | /// The generic rewriter, threaded through the sections so each can rewrite a subexpression: |
| | | 71 | | /// the variables bound inside the expression so far, and the expression. |
| | | 72 | | type Rewrite = Set<Var> -> Expr -> Expr |
| | | 73 | | |
| | | 74 | | /// A `unit` expression may compile to a void call, which cannot be the value of a lambda or |
| | | 75 | | /// of the block; end it with the unit constant so the tree has a `Unit` value. |
| | | 76 | | let asUnit (e: Expr) = |
| | 52984 | 77 | | if e.Type = typeof<unit> then Expr.Sequential(e, Expr.Value(())) else e |
| | | 78 | | |
| | | 79 | | /// A `unit`-typed call or application — possibly a void method, which the converter cannot |
| | | 80 | | /// use as a value — as opposed to `()` or a unit-typed variable. |
| | | 81 | | let isUnitCall (e: Expr) = |
| | 35354 | 82 | | e.Type = typeof<unit> && (match e with Call _ | Application _ -> true | _ -> false) |
| | | 83 | | |
| | | 84 | | /// On Mono's browser-wasm runtime a nested lambda that captures nothing loses its arguments |
| | | 85 | | /// when invoked (see DlrRuntime); one that captures is fine. So there, a nested delegate |
| | | 86 | | /// body is made to capture the block's closure parameter, which costs nothing elsewhere. |
| | | 87 | | let capturing (block: Block) (body: Expr) = |
| | 36272 | 88 | | if onWasm then Expr.Let(Var("captured", block.Closure.Type), Expr.Var block.Closure, body) else body |
| | | 89 | | |
| | | 90 | | /// The struct variable a receiver is rooted at, with the struct fields down from it: |
| | | 91 | | /// `v`, `v.Inner`, `v.Inner.Point`. |
| | | 92 | | let rec structPath (e: Expr) : (Var * Reflection.FieldInfo list) option = |
| | 10204 | 93 | | match e with |
| | 10700 | 94 | | | Var v when v.Type.IsValueType -> Some(v, []) |
| | 742 | 95 | | | FieldGet(Some inner, f) when f.FieldType.IsValueType -> structPath inner |> Option.map (fun (v, fs) -> v, fs @ |
| | 7772 | 96 | | | _ -> None |
| | | 97 | | |
| | | 98 | | /// A struct variable that lives in a cell — a `let mutable` of the block, or a mutable captured |
| | | 99 | | /// from outside it, which the compiler stores as an FSharpRef — reads back as a copy, so an |
| | | 100 | | /// operation that mutates it in place (a field set, a property setter or a method, on the |
| | | 101 | | /// variable or a struct field of it) would be lost (#162). It runs on a temporary copy that is |
| | | 102 | | /// written back, in a finally. The arguments are evaluated first, left to right, into temporaries: the |
| | | 103 | | /// receiver is a variable, so this is F#'s order, and an argument that mutates the variable |
| | | 104 | | /// itself is not overwritten by a copy read before it ran. The copy is immutable to F# — so it |
| | | 105 | | /// is not celled again — but a LINQ variable, which a field set or call mutates in place. |
| | | 106 | | /// `isTarget` picks the cell variables; `read` and `write` are the cell's; `recurse` rewrites |
| | | 107 | | /// the arguments. None when `e` is not such an operation. |
| | | 108 | | let inPlace (isTarget: Var -> bool) (read: Var -> Expr) (write: Var -> Expr -> Expr) (recurse: Expr -> Expr) (e: Exp |
| | | 109 | | let rooted (receiver: Expr) = |
| | 9992 | 110 | | match structPath receiver with |
| | 3208 | 111 | | | Some(v, fields) when isTarget v -> Some(v, fields) |
| | 9004 | 112 | | | _ -> None |
| | | 113 | | let apply (v: Var) (fields: Reflection.FieldInfo list) (args: Expr list) (op: Expr -> Expr list -> Expr) = |
| | 2166 | 114 | | let temps = args |> List.mapi (fun i a -> Var(sprintf "arg%d" i, a.Type), recurse a) |
| | 988 | 115 | | let copy = Var(v.Name + "Copy", v.Type) |
| | 1582 | 116 | | let receiver = fields |> List.fold (fun r f -> Expr.FieldGet(r, f)) (Expr.Var copy) |
| | 3648 | 117 | | let result = op receiver [ for t, _ in temps -> Expr.Var t ] |
| | | 118 | | // Unit-typed both, as values: a void call or setter cannot be an argument. |
| | 3952 | 119 | | let asValue (e: Expr) = if e.Type = typeof<unit> then Expr.Sequential(e, Expr.Value(())) else e |
| | | 120 | | // The write-back in a finally (`Binders.InPlace`, made a TryFinally after conversion), |
| | | 121 | | // so a member that mutates then throws keeps its mutation, as in plain F#; the |
| | | 122 | | // arguments ran before, outside it, so a throwing argument writes nothing back. |
| | 988 | 123 | | let body = |
| | 988 | 124 | | Expr.Call(typeof<Binders.InPlace>.GetMethod("Then", Reflection.BindingFlags.Static ||| Reflection.Bindin |
| | 988 | 125 | | [ asValue result; asValue (write v (Expr.Var copy)) ]) |
| | 1672 | 126 | | List.foldBack (fun (t, a) inner -> Expr.Let(t, a, inner)) temps (Expr.Let(copy, read v, body)) |
| | 177893 | 127 | | match e with |
| | | 128 | | | FieldSet(Some receiver, f, x) -> |
| | 2044 | 129 | | rooted receiver |> Option.map (fun (v, fields) -> apply v fields [ x ] (fun r a -> Expr.FieldSet(r, f, List. |
| | | 130 | | | PropertySet(Some receiver, p, indexes, x) -> |
| | 4089 | 131 | | rooted receiver |> Option.map (fun (v, fields) -> |
| | 3118 | 132 | | apply v fields (indexes @ [ x ]) (fun r a -> Expr.PropertySet(r, p, List.last a, List.take indexes.Lengt |
| | | 133 | | | Call(Some receiver, mi, args) -> |
| | 10411 | 134 | | rooted receiver |> Option.map (fun (v, fields) -> apply v fields args (fun r a -> Expr.Call(r, mi, a))) |
| | 167901 | 135 | | | _ -> None |
| | | 136 | | |
| | | 137 | | /// Where a free variable of the body comes from: the Delay closure, or failing that the |
| | | 138 | | /// enclosing member's body. |
| | | 139 | | module Captures = |
| | | 140 | | |
| | | 141 | | /// The container's fields by name. A state machine also has fields of its own, `Data` |
| | | 142 | | /// (a `DlrData<_>`) and `ResumptionPoint` (an int), declared first, and they are skipped |
| | | 143 | | /// rather than found by name: a captured `Data` gets a second field of that name after |
| | | 144 | | /// them (IL allows it, the types differ); a captured `ResumptionPoint` is an `FSharpRef` |
| | | 145 | | /// when mutable, a compiler error (FS2014, as in `task { }`) when an `int` the optimizer |
| | | 146 | | /// kept, and when it inlined the value there is no field, and the body's variable of that |
| | | 147 | | /// name must resolve from the enclosing member, not to the machine's own counter. |
| | | 148 | | let fields (containerType: Type) : Collections.Generic.IDictionary<string, Reflection.FieldInfo> = |
| | 8474 | 149 | | let all = containerType.GetFields(Reflection.BindingFlags.Instance ||| Reflection.BindingFlags.Public ||| Re |
| | | 150 | | let isData (f: Reflection.FieldInfo) = |
| | 19357 | 151 | | f.Name = "Data" && f.FieldType.IsGenericType && f.FieldType.GetGenericTypeDefinition() = typedefof<DlrDa |
| | | 152 | | let own = |
| | 8474 | 153 | | if containerType.IsValueType then |
| | 4196 | 154 | | [ yield! all |> Array.filter isData |
| | 19355 | 155 | | yield! all |> Array.filter (fun f -> f.Name = "ResumptionPoint" && f.FieldType = typeof<int>) |> A |
| | 4278 | 156 | | else [] |
| | 8474 | 157 | | let fields = Collections.Generic.Dictionary<string, Reflection.FieldInfo>() |
| | 52898 | 158 | | for f in all do |
| | 27558 | 159 | | if not (List.contains f own) then fields.[f.Name] <- f |
| | 8474 | 160 | | fields :> _ |
| | | 161 | | |
| | | 162 | | /// Whether recovering `e` runs nothing twice: the optimizer moves no effect into the |
| | | 163 | | /// block's closure, so an effect in a recovered definition has run already, outside it |
| | | 164 | | /// (#203). Literals, immutable variables and module values, lambdas (built, not run), the |
| | | 165 | | /// F# operators on primitives, and tuples, unions, records, lets of those. |
| | | 166 | | let rec effectFree (e: Expr) = |
| | 281 | 167 | | match e with |
| | 213 | 168 | | | Value _ | Lambda _ | DefaultValue _ -> true |
| | | 169 | | // Not a mutable: read again, it gives its current value, not the one bound (#211 review). |
| | 32 | 170 | | | Var v -> not v.IsMutable |
| | | 171 | | // A module's immutable value (`let answer = 42`): reading it runs nothing. Not a class's |
| | | 172 | | // static property, whose getter can run code. |
| | | 173 | | | PropertyGet(None, p, []) -> |
| | 0 | 174 | | not p.CanWrite |
| | 4 | 175 | | && (p.DeclaringType.GetCustomAttributes(typeof<CompilationMappingAttribute>, false) |
| | 8 | 176 | | |> Seq.exists (fun a -> (a :?> CompilationMappingAttribute).SourceConstructFlags = SourceConstructFl |
| | 4 | 177 | | | NewTuple es | NewUnionCase(_, es) | NewRecord(_, es) -> List.forall effectFree es |
| | 0 | 178 | | | Coerce(x, _) | TupleGet(x, _) -> effectFree x |
| | 2 | 179 | | | Let(_, d, b) -> effectFree d && effectFree b |
| | 16 | 180 | | | LetRecursive(bs, b) -> List.forall (snd >> effectFree) bs && effectFree b |
| | 18 | 181 | | | Call(None, mi, args) when mi.DeclaringType.FullName = "Microsoft.FSharp.Core.Operators" -> |
| | | 182 | | // `fst`/`snd`, and the arithmetic, comparison, bitwise and `not` operators on |
| | | 183 | | // primitives and strings. Not every operator: one on a user's type calls the user's |
| | | 184 | | // code (`+`, `=` through `Equals`), and `|>` calls a function. |
| | 8 | 185 | | let primitive (t: Type) = t.IsPrimitive || t = typeof<string> || t = typeof<decimal> |
| | | 186 | | let plain = |
| | 12 | 187 | | match mi.Name with |
| | 8 | 188 | | | "Fst" | "Snd" -> true |
| | | 189 | | | "op_Addition" | "op_Subtraction" | "op_Multiply" | "op_Division" | "op_Modulus" |
| | | 190 | | | "op_UnaryNegation" | "op_UnaryPlus" |
| | | 191 | | | "op_Equality" | "op_Inequality" | "op_LessThan" | "op_GreaterThan" | "op_LessThanOrEqual" | "op_Gr |
| | | 192 | | | "op_BitwiseAnd" | "op_BitwiseOr" | "op_ExclusiveOr" | "op_LogicalNot" | "op_LeftShift" | "op_Right |
| | 12 | 193 | | args |> List.forall (fun a -> primitive a.Type) |
| | 0 | 194 | | | _ -> false |
| | 24 | 195 | | plain && List.forall effectFree args |
| | 6 | 196 | | | _ -> false |
| | | 197 | | |
| | | 198 | | /// The field element `i` of a reference tuple the Release optimizer split is held in: `t_0`, |
| | | 199 | | /// `t_1`, … (`ExpandStructuralBinding`), with `$tupleElem` after each when its definition |
| | | 200 | | /// branched (`TryRewriteBranchingTupleBinding`); an element nothing reads has none (#203). |
| | | 201 | | let elementField (fields: Collections.Generic.IDictionary<string, Reflection.FieldInfo>) (v: Var) (i: int) : Ref |
| | 9446 | 202 | | if not (FSharpType.IsTuple v.Type) || v.Type.IsValueType || fields.ContainsKey v.Name then None |
| | | 203 | | else |
| | 98 | 204 | | let t = (FSharpType.GetTupleElements v.Type).[i] |
| | 98 | 205 | | [ sprintf "%s_%d" v.Name i; sprintf "%s_%d$tupleElem" v.Name i ] |
| | 98 | 206 | | |> List.tryPick (fun name -> |
| | 152 | 207 | | match fields.TryGetValue name with |
| | 100 | 208 | | | true, f when f.FieldType = t -> Some f |
| | 200 | 209 | | | _ -> None) |
| | | 210 | | |
| | | 211 | | /// The fields a reference tuple the Release optimizer split is held in, one per element: |
| | | 212 | | /// `t_0`, `t_1`, … (`ExpandStructuralBinding`), with `$tupleElem` after each when its |
| | | 213 | | /// definition branched (`TryRewriteBranchingTupleBinding`). Its definition would run again |
| | | 214 | | /// (#203). An element with no field (a constant the optimizer inlined) is the one in the |
| | | 215 | | /// definition's tuple, when that is effect-free. |
| | | 216 | | let elements (fields: Collections.Generic.IDictionary<string, Reflection.FieldInfo>) (memberBody: Expr) (v: Var) |
| | 9380 | 217 | | if not (FSharpType.IsTuple v.Type) || v.Type.IsValueType then None |
| | | 218 | | else |
| | 60 | 219 | | let found = FSharpType.GetTupleElements v.Type |> Array.mapi (fun i _ -> elementField fields v i) |> Lis |
| | 28 | 220 | | if List.forall Option.isNone found then None |
| | | 221 | | else |
| | | 222 | | // An element the optimizer inlined (a constant) has no field: the definition's. |
| | 24 | 223 | | let literal = match letDefinition v memberBody with Some(NewTuple es) -> Some es | _ -> None |
| | | 224 | | let parts = |
| | 12 | 225 | | found |> List.mapi (fun i f -> |
| | 24 | 226 | | match f, literal with |
| | 12 | 227 | | | Some f, _ -> Some(Choice1Of2 f) |
| | 22 | 228 | | | None, Some es when effectFree es.[i] -> Some(Choice2Of2 es.[i]) |
| | 14 | 229 | | | None, _ -> None) |
| | 24 | 230 | | if List.forall Option.isSome parts then Some(List.choose id parts) else None |
| | | 231 | | |
| | | 232 | | /// Names a split tuple's element field and a variable of the member could both have: a |
| | | 233 | | /// variable named `t_0` beside a tuple `t`. The optimizer's `t_0` then becomes `t_00` or the |
| | | 234 | | /// user's does, in an order of its own, so neither is told apart by name: both refused. |
| | | 235 | | /// `split`: whether the container may hold `t` split (a container with a field `t` holds it |
| | | 236 | | /// whole, as every Debug closure does). |
| | | 237 | | let elementNameClashes (split: string -> bool) (memberBody: Expr) : Set<string> = |
| | 4246 | 238 | | let vars = Collections.Generic.HashSet<Var>(HashIdentity.Reference) |
| | | 239 | | let rec go (e: Expr) = |
| | 690870 | 240 | | match e with |
| | 166605 | 241 | | | ShapeVar v -> vars.Add v |> ignore |
| | 285622 | 242 | | | ShapeLambda(v, b) -> vars.Add v |> ignore; go b |
| | 2394347 | 243 | | | ShapeCombination(_, es) -> for x in es do go x |
| | 4246 | 244 | | go memberBody |
| | 147057 | 245 | | let names = vars |> Seq.map (fun v -> v.Name) |> Set.ofSeq |
| | 155549 | 246 | | set [ for v in vars do |
| | 291166 | 247 | | if FSharpType.IsTuple v.Type && not v.Type.IsValueType && split v.Name then |
| | 14199 | 248 | | for i in 0 .. (FSharpType.GetTupleElements v.Type).Length - 1 do |
| | 6420 | 249 | | let element = sprintf "%s_%d" v.Name i |
| | 12840 | 250 | | if names.Contains element then |
| | 4 | 251 | | yield v.Name |
| | 4250 | 252 | | yield element ] |
| | | 253 | | |
| | | 254 | | /// The variables a block reaches: its free variables and, for each one with no field of |
| | | 255 | | /// its name, those of the definition `read` would recover for it. An alias reached that |
| | | 256 | | /// way (an immutable `let` of an immutable variable or of a literal) is the optimizer's to |
| | | 257 | | /// substitute, never a field, so it stands for what it names: it is returned apart, not |
| | | 258 | | /// counted with the rest. One of a mutable it keeps, holding the value at the time. |
| | | 259 | | let reached (fields: Collections.Generic.IDictionary<string, Reflection.FieldInfo>) (memberBody: Expr) (body: Ex |
| | 12702 | 260 | | let own = body.GetFreeVars() |> Set.ofSeq |
| | | 261 | | let rec go (seen: Set<Var>) counted aliases (pending: Var list) = |
| | 22568 | 262 | | match pending with |
| | 8474 | 263 | | | [] -> counted, aliases |
| | 14140 | 264 | | | v :: rest when seen.Contains v -> go seen counted aliases rest |
| | | 265 | | | v :: rest -> |
| | 14048 | 266 | | let seen = seen.Add v |
| | 14048 | 267 | | let def = letDefinition v memberBody |
| | 20986 | 268 | | let alias = not v.IsMutable && not (own.Contains v) && (match def with Some(Var y) -> not y.IsMutabl |
| | | 269 | | let inner = |
| | 56210 | 270 | | if (fields.ContainsKey v.Name || (elementField fields v 0).IsSome || (elements fields memberBody |
| | | 271 | | else |
| | 4481 | 272 | | match def |> Option.orElse (parameterArgument v memberBody) with |
| | 4473 | 273 | | | Some d -> List.ofSeq (d.GetFreeVars()) |
| | 0 | 274 | | | None -> [] |
| | 14058 | 275 | | if alias then go seen counted (Set.add v aliases) (inner @ rest) |
| | 14038 | 276 | | else go seen (v :: counted) aliases (inner @ rest) |
| | 8474 | 277 | | go Set.empty [] Set.empty (List.ofSeq own) |
| | | 278 | | |
| | | 279 | | /// Two variables of one name, one reached through a local function or alias the optimizer |
| | | 280 | | /// inlined: the compiler names their fields `x`, `x0`, … in an order of its own, and a |
| | | 281 | | /// recovered definition would run again, so neither tells which is which (#196). |
| | | 282 | | let private ambiguous (v: Var) = |
| | 16 | 283 | | DlrTranslationException( |
| | 16 | 284 | | sprintf "dlr { } reaches two variables named '%s', one through a local function or alias the optimizer i |
| | | 285 | | |
| | | 286 | | let private isRefCell (f: Reflection.FieldInfo) (t: Type) = |
| | 374 | 287 | | f.FieldType.IsGenericType |
| | 374 | 288 | | && f.FieldType.GetGenericTypeDefinition() = typedefof<Ref<_>> |
| | 374 | 289 | | && f.FieldType.GetGenericArguments().[0] = t |
| | | 290 | | |
| | | 291 | | /// A free variable of the body becomes a read of the closure field of the same name. |
| | | 292 | | /// A captured `let mutable` is stored as an FSharpRef cell; read through it. When there is |
| | | 293 | | /// no such field the optimizer inlined the variable's definition (a literal, a local |
| | | 294 | | /// function, ...) instead of capturing it, so substitute that definition from the |
| | | 295 | | /// enclosing member's body; its own free variables resolve the same way. A tuple split |
| | | 296 | | /// into a field per element is rebuilt from those (`elements`). |
| | | 297 | | let read (block: Block) (resolve: Expr -> Expr) (v: Var) : Expr = |
| | 5746 | 298 | | if block.Ambiguous.Contains v.Name then raise (ambiguous v) |
| | 17190 | 299 | | match (if block.Substituted.Contains v then (false, null) else block.Fields.TryGetValue v.Name) with |
| | 10814 | 300 | | | true, f when f.FieldType = v.Type -> Expr.FieldGet(block.Self, f) |
| | 188 | 301 | | | true, f when isRefCell f v.Type -> |
| | 188 | 302 | | Expr.PropertyGet(Expr.FieldGet(block.Self, f), f.FieldType.GetProperty("Value")) |
| | | 303 | | | true, f -> |
| | 0 | 304 | | raise (DlrTranslationException( |
| | 0 | 305 | | sprintf "dlr { } captured '%s' as %s but the body uses it as %s." v.Name f.FieldType.Name v.Type |
| | | 306 | | | _ -> |
| | 687 | 307 | | match (if block.Substituted.Contains v then None else elements block.Fields block.MemberBody v) with |
| | 54 | 308 | | | Some parts -> Expr.NewTuple [ for p in parts -> match p with Choice1Of2 f -> Expr.FieldGet(block.Self, |
| | | 309 | | | None -> |
| | | 310 | | let recovered (def: Expr) = |
| | 440 | 311 | | if effectFree def then resolve def |
| | | 312 | | else |
| | 6 | 313 | | raise (DlrTranslationException( |
| | 6 | 314 | | sprintf "dlr { } would run the definition of '%s' again: the optimizer did not capture i |
| | 223 | 315 | | match letDefinition v block.MemberBody with |
| | 215 | 316 | | | Some def -> recovered def |
| | | 317 | | | None -> |
| | 8 | 318 | | match parameterArgument v block.MemberBody with |
| | 8 | 319 | | | Some arg -> recovered arg |
| | | 320 | | | None -> |
| | 0 | 321 | | raise (DlrTranslationException( |
| | 0 | 322 | | sprintf "dlr { } could not find captured variable '%s' on closure %s (fields: %s), a let |
| | 0 | 323 | | v.Name block.ClosureType.Name (String.Join(", ", block.Fields.Keys)))) |
| | | 324 | | |
| | | 325 | | /// `fst v`, `snd v` or element `i` of `v` otherwise, read from its own field when the |
| | | 326 | | /// optimizer split `v` (`elementField`); None to read `v` itself. |
| | | 327 | | let element (block: Block) (v: Var) (i: int) : Expr option = |
| | 90 | 328 | | if block.Ambiguous.Contains v.Name then raise (ambiguous v) |
| | 78 | 329 | | if block.Substituted.Contains v then None |
| | 120 | 330 | | else elementField block.Fields v i |> Option.map (fun f -> Expr.FieldGet(block.Self, f)) |
| | | 331 | | |
| | | 332 | | /// Whether a captured variable is a mutable, stored in an FSharpRef cell. |
| | | 333 | | let isCell (block: Block) (v: Var) = |
| | 28 | 334 | | match block.Fields.TryGetValue v.Name with |
| | 56 | 335 | | | true, f when not (block.Ambiguous.Contains v.Name) -> isRefCell f v.Type |
| | 0 | 336 | | | _ -> false |
| | | 337 | | |
| | | 338 | | /// `v <- value` on a captured `let mutable`: a write through its FSharpRef cell. |
| | | 339 | | let assign (block: Block) (v: Var) (value: Expr) : Expr = |
| | 162 | 340 | | if block.Ambiguous.Contains v.Name then raise (ambiguous v) |
| | 158 | 341 | | match block.Fields.TryGetValue v.Name with |
| | 158 | 342 | | | true, f when isRefCell f v.Type -> |
| | 158 | 343 | | Expr.PropertySet(Expr.FieldGet(block.Self, f), f.FieldType.GetProperty("Value"), value) |
| | | 344 | | | _ -> |
| | 0 | 345 | | raise (DlrTranslationException( |
| | 0 | 346 | | sprintf "dlr { } assigns '%s', which is not a captured mutable on closure %s (fields: %s)." |
| | 0 | 347 | | v.Name block.ClosureType.Name (String.Join(", ", block.Fields.Keys)))) |
| | | 348 | | |
| | | 349 | | /// The builder's own methods: `Return`/`Zero`/`Combine` fold away, and the control-flow |
| | | 350 | | /// members become `DlrRuntime` calls over delegates. |
| | | 351 | | module Plumbing = |
| | | 352 | | |
| | | 353 | | /// A body as a `Func<..>` delegate over `vars` (see DlrRuntime for why not an F# function). |
| | | 354 | | /// The delegate's type is built from the variables' types and the body's; a `unit` body |
| | | 355 | | /// (which may compile to a void call) becomes a `Func<.., unit>`, not an `Action`. |
| | | 356 | | /// A raw `try … with`'s handler, run as a delegate (`DlrRuntime.tryWith`), is outside any |
| | | 357 | | /// catch block, so its `reraise ()` — F# puts one where no case matches — throws the |
| | | 358 | | /// caught exception `ex` again instead (`DlrRuntime.rethrow`, keeping its stack trace). A |
| | | 359 | | /// nested `try … with` keeps its own handler's. (The builder's handlers need none: there |
| | | 360 | | /// the compiler's unmatched case is already an ExceptionDispatchInfo rethrow, and an |
| | | 361 | | /// explicit `reraise ()` does not compile.) |
| | | 362 | | let rethrowing (ex: Var) (handler: Expr) : Expr = |
| | | 363 | | let rec go (e: Expr) = |
| | 2152 | 364 | | match e with |
| | 408 | 365 | | | Call(None, mi, []) when mi.IsGenericMethod && mi.GetGenericMethodDefinition() = reraiseMethod -> |
| | 204 | 366 | | Expr.Call(rethrow.GetGenericMethodDefinition().MakeGenericMethod(e.Type), [ Expr.Var ex ]) |
| | 4 | 367 | | | TryWith(body, fv, filter, cv, catch) -> Expr.TryWith(go body, fv, filter, cv, catch) |
| | 1944 | 368 | | | _ -> Quotation.rebuild go e |
| | 512 | 369 | | go handler |
| | | 370 | | |
| | | 371 | | let func (block: Block) (rewriteIn: Rewrite) (bound: Set<Var>) (vars: Var list) (body: Expr) : Expr = |
| | 8230 | 372 | | let bound = vars |> List.fold (fun b v -> Set.add v b) bound |
| | 4052 | 373 | | let body = capturing block (asUnit (rewriteIn bound body)) |
| | | 374 | | // A parameterless delegate whose body is itself a lambda (`try (fun x -> …) with …`) |
| | | 375 | | // reads back from FSharp.Core as a delegate of that lambda's parameter: hold the lambda |
| | | 376 | | // in a `let` so it stays the result. |
| | | 377 | | let body = |
| | 4052 | 378 | | match vars, body with |
| | 16 | 379 | | | [], Lambda _ -> let result = Var("result", body.Type) in Expr.Let(result, body, Expr.Var result) |
| | 4044 | 380 | | | _ -> body |
| | 12282 | 381 | | let delegateType = Expression.GetFuncType(Array.append (vars |> List.map (fun v -> v.Type) |> Array.ofList) |
| | 4052 | 382 | | Expr.NewDelegate(delegateType, vars, body) |
| | | 383 | | |
| | | 384 | | /// A call on the builder (Discover already unwrapped the outermost Delay). |
| | | 385 | | let call (block: Block) (rewriteIn: Rewrite) (bound: Set<Var>) (mi: Reflection.MethodInfo) (args: Expr list) (e: |
| | 13614 | 386 | | let rewrite = rewriteIn bound |
| | 6802 | 387 | | let func = func block rewriteIn bound |
| | 13614 | 388 | | match mi.Name, args with |
| | 9276 | 389 | | | "Return", [ value ] -> rewrite value |
| | 1348 | 390 | | | "Zero", [] -> Expr.Value(()) |
| | 726 | 391 | | | "Combine", [ first; Call(_, d, [ Lambda(_, rest) ]) ] when d.Name = "Delay" -> |
| | 726 | 392 | | Expr.Sequential(rewrite first, rewrite rest) |
| | | 393 | | | "For", [ items; Lambda(x, body) ] -> |
| | 788 | 394 | | let items = rewrite items |
| | 788 | 395 | | Expr.Call(forEach.MakeGenericMethod(x.Type), [ items; func [ x ] body ]) |
| | 6 | 396 | | | "While", [ Lambda(_, guard); Call(_, d, [ Lambda(_, body) ]) ] when d.Name = "Delay" -> |
| | 6 | 397 | | Expr.Call(whileLoop, [ func [] guard; func [] body ]) |
| | 370 | 398 | | | "TryWith", [ Call(_, d, [ Lambda(_, body) ]); Lambda(ex, handler) ] when d.Name = "Delay" -> |
| | 370 | 399 | | Expr.Call(tryWith.MakeGenericMethod(codeType e.Type), [ func [] body; func [ ex ] handler ]) |
| | 8 | 400 | | | "TryFinally", [ Call(_, d, [ Lambda(_, body) ]); Lambda(_, compensation) ] when d.Name = "Delay" -> |
| | 8 | 401 | | Expr.Call(tryFinally.MakeGenericMethod(codeType e.Type), [ func [] body; func [] compensation ]) |
| | | 402 | | | "Using", [ resource; Lambda(r, body) ] -> |
| | 6 | 403 | | Expr.Call(using.MakeGenericMethod(r.Type, codeType e.Type), [ rewrite resource; func [ r ] body ]) |
| | | 404 | | // A nested dlr { } is compiled as part of this one: at run time its closure would be |
| | | 405 | | // made by our compiled code, not the F# compiler, so it has no reflected body of its own. |
| | 696 | 406 | | | "Run", [ Call(_, d, [ Lambda(_, inner) ]); _; _ ] when d.Name = "Delay" -> rewrite inner |
| | 0 | 407 | | | name, _ -> unsupported (sprintf "the '%s' construct" name) e |