Traverse quotation

Shows how to use the 'ExprShape' module to recursively traverse an entire quotation and how to write quotation transformations. As an example, the snippet replaces all numeric constants in the quotation and then runs the transformed code.

Copy Source
Copy Link
Tools:

Quotation transformation

 1: open Microsoft.FSharp.Quotations
 2: 
 3: /// Traverse an entire quotation and use the provided function
 4: /// to transform some parts of the quotation. If the function 'f'
 5: /// returns 'Some' for some sub-quotation then we replace that
 6: /// part of the quotation. The function then recursively processes
 7: /// the quotation tree.
 8: let rec traverseQuotation f q = 
 9:   let q = defaultArg (f q) q
10:   match q with
11:   | ExprShape.ShapeCombination(a, args) -> 
12:       let nargs = args |> List.map (traverseQuotation f)
13:       ExprShape.RebuildShapeCombination(a, nargs)
14:   | ExprShape.ShapeLambda(v, body)  -> 
15:       Expr.Lambda(v, traverseQuotation f body)
16:   | ExprShape.ShapeVar(v) ->
17:       Expr.Var(v)
18: 
19: // Sample quotation (written explicitly using <@ .. @>)
20: let quot = 
21:  <@ let a = 10 
22:     let b = 32 / a
23:     a / b @>

Example: Finding constants

 1: /// Find all constants in the quotation and print them...  
 2: let findConstants quot =
 3:   quot |> traverseQuotation (fun q -> 
 4:     match q with 
 5:     | Patterns.Value(v, typ) -> printfn "Constant: %A" v
 6:     | _ -> ()
 7:     None ) 
 8:   |> ignore
 9: 
10: findConstants quot  

Example: Multiply constants by two

 1: /// Multiply all integer constants by two and compile the 
 2: /// returned quotation & evaluate it
 3: let quotTwoTimes quot = 
 4:   quot |> traverseQuotation (fun q -> 
 5:     match q with 
 6:     | Patterns.Value(v, typ) when typ = typeof<int> ->
 7:         Some(Expr.Value((unbox v) * 2))
 8:     | _ -> None )
 9: 
10: // Compile & run modified quotation
11: #r "FSharp.PowerPack.Linq.dll"
12: open Microsoft.FSharp.Linq.QuotationEvaluation
13:     
14: let quotTwoTimesTyped = Expr.Cast<int>(quotTwoTimes quot)    
15: quotTwoTimesTyped.Eval()
namespace Microsoft
namespace Microsoft.FSharp
namespace Microsoft.FSharp.Quotations
val traverseQuotation : (Expr -> Expr option) -> Expr -> Expr

Full name: Test.traverseQuotation

Traverse an entire quotation and use the provided function
 to transform some parts of the quotation. If the function 'f'
 returns 'Some' for some sub-quotation then we replace that
 part of the quotation. The function then recursively processes
 the quotation tree.

val f : (Expr -> Expr option)
val q : Expr
val defaultArg : 'T option -> 'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.defaultArg
module ExprShape

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

Full name: Microsoft.FSharp.Quotations.ExprShape.( |ShapeVar|ShapeLambda|ShapeCombination| )
val a : obj
val args : Expr list

  type: Expr list
  implements: System.Collections.IStructuralEquatable
  implements: System.IComparable<List<Expr>>
  implements: System.IComparable
  implements: System.Collections.IStructuralComparable
  implements: System.Collections.Generic.IEnumerable<Expr>
  implements: System.Collections.IEnumerable
val nargs : Expr list

  type: Expr list
  implements: System.Collections.IStructuralEquatable
  implements: System.IComparable<List<Expr>>
  implements: System.IComparable
  implements: System.Collections.IStructuralComparable
  implements: System.Collections.Generic.IEnumerable<Expr>
  implements: System.Collections.IEnumerable
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------

type List<'T> =
  | ( [] )
  | ( :: ) of 'T * 'T list
  with
    interface System.Collections.IEnumerable
    interface System.Collections.Generic.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
  end

Full name: Microsoft.FSharp.Collections.List<_>

  type: List<'T>
  implements: System.Collections.IStructuralEquatable
  implements: System.IComparable<List<'T>>
  implements: System.IComparable
  implements: System.Collections.IStructuralComparable
  implements: System.Collections.Generic.IEnumerable<'T>
  implements: System.Collections.IEnumerable
val map : ('T -> 'U) -> 'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.map
val RebuildShapeCombination : obj * Expr list -> Expr

Full name: Microsoft.FSharp.Quotations.ExprShape.RebuildShapeCombination
active recognizer ShapeLambda: Expr -> Choice<Var,(Var * Expr),(obj * Expr list)>

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

  type: Var
  implements: System.IComparable
val body : Expr
Multiple items
type Expr<'T> =
  class
    inherit Expr
    member Raw : Expr
  end

Full name: Microsoft.FSharp.Quotations.Expr<_>

  type: Expr<'T>
  inherits: Expr


--------------------

type Expr =
  class
    override Equals : obj:obj -> bool
    member GetFreeVars : unit -> seq<Var>
    member Substitute : substitution:(Var -> Expr option) -> Expr
    member CustomAttributes : Expr list
    member Type : System.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
    static member Call : methodInfo:System.Reflection.MethodInfo * arguments:Expr list -> Expr
    static member Call : obj:Expr * methodInfo:System.Reflection.MethodInfo * arguments:Expr list -> Expr
    static member Cast : source:Expr -> Expr<'T>
    static member Coerce : source:Expr * target:System.Type -> Expr
    static member DefaultValue : expressionType:System.Type -> Expr
    static member Deserialize : qualifyingType:System.Type * spliceTypes:System.Type list * spliceExprs:Expr list * bytes:byte [] -> Expr
    static member FieldGet : fieldInfo:System.Reflection.FieldInfo -> Expr
    static member FieldGet : obj:Expr * fieldInfo:System.Reflection.FieldInfo -> Expr
    static member FieldSet : fieldInfo:System.Reflection.FieldInfo * value:Expr -> Expr
    static member FieldSet : obj:Expr * fieldInfo:System.Reflection.FieldInfo * value:Expr -> Expr
    static member ForIntegerRangeLoop : loopVariable:Var * start:Expr * endExpr:Expr * body:Expr -> Expr
    static member GlobalVar : name:string -> Expr<'T>
    static member IfThenElse : guard:Expr * thenExpr:Expr * elseExpr:Expr -> Expr
    static member Lambda : parameter:Var * body:Expr -> Expr
    static member Let : letVariable:Var * letExpr:Expr * body:Expr -> Expr
    static member LetRecursive : bindings:(Var * Expr) list * body:Expr -> Expr
    static member NewArray : elementType:System.Type * elements:Expr list -> Expr
    static member NewDelegate : delegateType:System.Type * parameters:Var list * body:Expr -> Expr
    static member NewObject : constructorInfo:System.Reflection.ConstructorInfo * arguments:Expr list -> Expr
    static member NewRecord : recordType:System.Type * elements:Expr list -> Expr
    static member NewTuple : elements:Expr list -> Expr
    static member NewUnionCase : unionCase:Reflection.UnionCaseInfo * arguments:Expr list -> Expr
    static member PropertyGet : property:System.Reflection.PropertyInfo * ?indexerArgs:Expr list -> Expr
    static member PropertyGet : obj:Expr * property:System.Reflection.PropertyInfo * ?indexerArgs:Expr list -> Expr
    static member PropertySet : property:System.Reflection.PropertyInfo * value:Expr * ?indexerArgs:Expr list -> Expr
    static member PropertySet : obj:Expr * property:System.Reflection.PropertyInfo * value:Expr * ?indexerArgs:Expr list -> Expr
    static member Quote : inner:Expr -> Expr
    static member RegisterReflectedDefinitions : assembly:System.Reflection.Assembly * resource:string * serializedValue:byte [] -> unit
    static member Sequential : first:Expr * second:Expr -> Expr
    static member TryFinally : body:Expr * compensation:Expr -> Expr
    static member TryGetReflectedDefinition : methodBase:System.Reflection.MethodBase -> Expr option
    static member TryWith : body:Expr * filterVar:Var * filterBody:Expr * catchVar:Var * catchBody:Expr -> Expr
    static member TupleGet : tuple:Expr * index:int -> Expr
    static member TypeTest : source:Expr * target:System.Type -> Expr
    static member UnionCaseTest : source:Expr * unionCase:Reflection.UnionCaseInfo -> Expr
    static member Value : value:'T -> Expr
    static member Value : value:obj * expressionType:System.Type -> Expr
    static member Var : variable:Var -> Expr
    static member VarSet : variable:Var * value:Expr -> Expr
    static member WhileLoop : guard:Expr * body:Expr -> Expr
  end

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

Full name: Microsoft.FSharp.Quotations.ExprShape.( |ShapeVar|ShapeLambda|ShapeCombination| )
static member Expr.Var : variable:Var -> Expr
val quot : Expr<int>

Full name: Test.quot

  type: Expr<int>
  inherits: Expr
val a : int

  type: int
  implements: System.IComparable
  implements: System.IFormattable
  implements: System.IConvertible
  implements: System.IComparable<int>
  implements: System.IEquatable<int>
  inherits: System.ValueType
val b : int

  type: int
  implements: System.IComparable
  implements: System.IFormattable
  implements: System.IConvertible
  implements: System.IComparable<int>
  implements: System.IEquatable<int>
  inherits: System.ValueType
val findConstants : Expr -> unit

Full name: Test.findConstants

Find all constants in the quotation and print them...
val quot : Expr
module Patterns

from Microsoft.FSharp.Quotations
active recognizer Value: Expr -> (obj * System.Type) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |Value|_| )
val v : obj
val typ : System.Type

  type: System.Type
  implements: System.Reflection.ICustomAttributeProvider
  implements: System.Runtime.InteropServices._MemberInfo
  implements: System.Runtime.InteropServices._Type
  implements: System.Reflection.IReflect
  inherits: System.Reflection.MemberInfo
val printfn : Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
union case Option.None: Option<'T>
val ignore : 'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
val quotTwoTimes : Expr -> Expr

Full name: Test.quotTwoTimes

Multiply all integer constants by two and compile the
 returned quotation & evaluate it

val typeof<'T> : System.Type

Full name: Microsoft.FSharp.Core.Operators.typeof
Multiple items
val int : 'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------

type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>

  type: int<'Measure>
  implements: System.IComparable
  implements: System.IConvertible
  implements: System.IFormattable
  implements: System.IComparable<int<'Measure>>
  implements: System.IEquatable<int<'Measure>>
  inherits: System.ValueType


--------------------

type int = int32

Full name: Microsoft.FSharp.Core.int

  type: int
  implements: System.IComparable
  implements: System.IFormattable
  implements: System.IConvertible
  implements: System.IComparable<int>
  implements: System.IEquatable<int>
  inherits: System.ValueType
union case Option.Some: 'T -> Option<'T>
Multiple overloads
static member Expr.Value : value:'T -> Expr
static member Expr.Value : value:obj * expressionType:System.Type -> Expr
val unbox : obj -> 'T

Full name: Microsoft.FSharp.Core.Operators.unbox
namespace Microsoft.FSharp.Linq
module QuotationEvaluation

from Microsoft.FSharp.Linq
val quotTwoTimesTyped : Expr<int>

Full name: Test.quotTwoTimesTyped

  type: Expr<int>
  inherits: Expr
static member Expr.Cast : source:Expr -> Expr<'T>
member Expr.Eval : unit -> 'T

More information

Link: http://fssnip.net/1i
Posted: 3 years ago
Author: Tomas Petricek (website)
Tags: quotations, traversal, transformation, compilation