7 people like it.

Expanding quotations

The snippet implements a function "expand" that takes a quotation and performs two operations. It replaces all calls to methods marked with ReflectedDefinition with the body of the method and it simplifies all expressions that can be reduced in call-by-name style (let binding & application of lambda).

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
open Microsoft.FSharp.Quotations
    
/// The parameter 'vars' is an immutable map that assigns expressions to variables
/// (as we recursively process the tree, we replace all known variables)
let rec expand vars expr = 

  // First recursively process & replace variables
  let expanded = 
    match expr with
    // If the variable has an assignment, then replace it with the expression
    | ExprShape.ShapeVar v when Map.containsKey v vars -> vars.[v]
    // Apply 'expand' recursively on all sub-expressions
    | ExprShape.ShapeVar v -> Expr.Var v
    | Patterns.Call(body, DerivedPatterns.MethodWithReflectedDefinition meth, args) ->
        let this = match body with Some b -> Expr.Application(meth, b) | _ -> meth
        let res = Expr.Applications(this, [ for a in args -> [a]])
        expand vars res
    | ExprShape.ShapeLambda(v, expr) -> 
        Expr.Lambda(v, expand vars expr)
    | ExprShape.ShapeCombination(o, exprs) ->
        ExprShape.RebuildShapeCombination(o, List.map (expand vars) exprs)

  // After expanding, try reducing the expression - we can replace 'let'
  // expressions and applications where the first argument is lambda
  match expanded with
  | Patterns.Application(ExprShape.ShapeLambda(v, body), assign)
  | Patterns.Let(v, assign, body) ->
      expand (Map.add v (expand vars assign) vars) body
  | _ -> expanded


// The following example replaces the function `foo` with its 
// body and then replaces the application, so you end up 
// with <@ (10 + 2) * (10 + 2) @>

[<ReflectedDefinition>]
let foo a = a * a
    
expand Map.empty <@ foo (10 + 2) @>
namespace Microsoft
namespace Microsoft.FSharp
namespace Microsoft.FSharp.Quotations
val expand : vars:Map<Var,Expr> -> expr:Expr -> Expr

Full name: Script.expand


 The parameter 'vars' is an immutable map that assigns expressions to variables
 (as we recursively process the tree, we replace all known variables)
val vars : Map<Var,Expr>
val expr : Expr
val expanded : Expr
module ExprShape

from Microsoft.FSharp.Quotations
active recognizer ShapeVar: Expr -> Choice<Var,(Var * Expr),(obj * Expr list)>

Full name: Microsoft.FSharp.Quotations.ExprShape.( |ShapeVar|ShapeLambda|ShapeCombination| )
val v : Var
Multiple items
module Map

from Microsoft.FSharp.Collections

--------------------
type Map<'Key,'Value (requires comparison)> =
  interface IEnumerable
  interface IComparable
  interface IEnumerable<KeyValuePair<'Key,'Value>>
  interface ICollection<KeyValuePair<'Key,'Value>>
  interface IDictionary<'Key,'Value>
  new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
  member Add : key:'Key * value:'Value -> Map<'Key,'Value>
  member ContainsKey : key:'Key -> bool
  override Equals : obj -> bool
  member Remove : key:'Key -> Map<'Key,'Value>
  ...

Full name: Microsoft.FSharp.Collections.Map<_,_>

--------------------
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
val containsKey : key:'Key -> table:Map<'Key,'T> -> bool (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.containsKey
Multiple items
type Expr =
  override Equals : obj:obj -> bool
  member GetFreeVars : unit -> seq<Var>
  member Substitute : substitution:(Var -> Expr option) -> Expr
  member ToString : full:bool -> string
  member CustomAttributes : Expr list
  member Type : Type
  static member AddressOf : target:Expr -> Expr
  static member AddressSet : target:Expr * value:Expr -> Expr
  static member Application : functionExpr:Expr * argument:Expr -> Expr
  static member Applications : functionExpr:Expr * arguments:Expr list list -> Expr
  ...

Full name: Microsoft.FSharp.Quotations.Expr

--------------------
type Expr<'T> =
  inherit Expr
  member Raw : Expr

Full name: Microsoft.FSharp.Quotations.Expr<_>
static member Expr.Var : variable:Var -> Expr
module Patterns

from Microsoft.FSharp.Quotations
active recognizer Call: Expr -> (Expr option * System.Reflection.MethodInfo * Expr list) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |Call|_| )
val body : Expr option
module DerivedPatterns

from Microsoft.FSharp.Quotations
active recognizer MethodWithReflectedDefinition: System.Reflection.MethodBase -> Expr option

Full name: Microsoft.FSharp.Quotations.DerivedPatterns.( |MethodWithReflectedDefinition|_| )
val meth : Expr
val args : Expr list
val this : Expr
union case Option.Some: Value: 'T -> Option<'T>
val b : Expr
static member Expr.Application : functionExpr:Expr * argument:Expr -> Expr
val res : Expr
static member Expr.Applications : functionExpr:Expr * arguments:Expr list list -> Expr
val a : Expr
active recognizer ShapeLambda: Expr -> Choice<Var,(Var * Expr),(obj * Expr list)>

Full name: Microsoft.FSharp.Quotations.ExprShape.( |ShapeVar|ShapeLambda|ShapeCombination| )
static member Expr.Lambda : parameter:Var * body:Expr -> Expr
active recognizer ShapeCombination: Expr -> Choice<Var,(Var * Expr),(obj * Expr list)>

Full name: Microsoft.FSharp.Quotations.ExprShape.( |ShapeVar|ShapeLambda|ShapeCombination| )
val o : obj
val exprs : Expr list
val RebuildShapeCombination : shape:obj * arguments:Expr list -> Expr

Full name: Microsoft.FSharp.Quotations.ExprShape.RebuildShapeCombination
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val map : mapping:('T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.map
active recognizer Application: Expr -> (Expr * Expr) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |Application|_| )
val body : Expr
val assign : Expr
active recognizer Let: Expr -> (Var * Expr * Expr) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |Let|_| )
val add : key:'Key -> value:'T -> table:Map<'Key,'T> -> Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.add
Multiple items
type ReflectedDefinitionAttribute =
  inherit Attribute
  new : unit -> ReflectedDefinitionAttribute

Full name: Microsoft.FSharp.Core.ReflectedDefinitionAttribute

--------------------
new : unit -> ReflectedDefinitionAttribute
val foo : a:int -> int

Full name: Script.foo
val a : int
val empty<'Key,'T (requires comparison)> : Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.empty
Raw view Test code New version

More information

Link:http://fssnip.net/bx
Posted:12 years ago
Author:Tomas Petricek
Tags: quotations , expand , lambda , quotation , exprshape