Quotation Printer

Allows you to pretty print a quotation.

 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: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48:

module QuotationPrinter = 
    
    open System
    open Microsoft.FSharp.Quotations

    let rec print depth (expr:Expr) = 
        match expr with
        | Patterns.Value (v, typ) -> sprintf "%A" v
        | Patterns.Var v ->  sprintf "%s:%s" v.Type.Name v.Name
        | Patterns.NewUnionCase (uci, args) -> 
            sprintf "%s(%s)" uci.Name (printArgs depth args)
        | Patterns.NewArray (_,args) -> 
            sprintf "[%s]" (printArgs depth args) 
        | Patterns.NewRecord (_,args) -> 
            sprintf "{%s}" (printArgs depth args)
        | Patterns.NewTuple args -> 
            sprintf "(%s)" (printArgs depth args)
        | Patterns.NewObject (ci, args) -> 
            sprintf "new %s(%s)" ci.Name (printArgs depth args)
        | Patterns.Call (Some (Patterns.ValueWithName(_,_,instance)), mi, args) -> 
            sprintf "%s.%s(%s)" instance mi.Name (printArgs (depth + 1) args)
        | Patterns.Call (None, mi, args) -> 
            sprintf "%s(%s)" mi.Name (printArgs (depth + 1) args)
        | Patterns.Lambda (var, body) -> 
            sprintf "(λ %s -> %s)" (print 0 (Expr.Var var)) (printArgs (depth + 1) [body])
        | Patterns.Let (var, bind, body) ->
            sprintf "let %s = %s in\r\n%*s%s" (print 0 (Expr.Var var)) (print 0 bind) ((depth - 1) * 4) "" (print depth body)
        | Patterns.PropertyGet (Some(var), pi, args) -> 
            sprintf "%s.%s" (print 0 var) pi.Name
        | Patterns.PropertySet (Some(var), pi, args, value) -> 
            sprintf "%s.%s <- %s" (print 0 var) pi.Name (print depth value)
        | Patterns.Sequential (x,y) -> 
            sprintf "%s; %s" (print depth x) (print depth y)
        | a -> failwithf "Unknown patterns %A" a

    and printArgs depth args = 
        match args with
        | [a] -> sprintf "\r\n%*s%s\r\n%*s" (depth * 4) "" (print (depth + 1) a) (depth * 4) ""
        | a -> 
            sprintf "\r\n%*s%s" (depth * 4) "" (String.Join(sprintf ",\r\n%*s" (depth * 4) "",List.map (print (depth + 1)) a))

    let enableFSI() =
#if INTERACTIVE
        fsi.AddPrinter (fun (x:Expr) -> print 0 x)
#endif
        ()

QuotationPrinter.enableFSI()

namespace System

namespace Microsoft

namespace Microsoft.FSharp

namespace Microsoft.FSharp.Quotations

val print : depth:int -> expr:Expr -> string

Full name: Script.QuotationPrinter.print

val depth : int

val expr : Expr

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<_>

module Patterns

from Microsoft.FSharp.Quotations

active recognizer Value: Expr -> (obj * Type) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |Value|_| )

val v : obj

val typ : Type

val sprintf : format:Printf.StringFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.sprintf

active recognizer Var: Expr -> Var option

Full name: Microsoft.FSharp.Quotations.Patterns.( |Var|_| )

val v : Var

property Var.Type: Type

property Reflection.MemberInfo.Name: string

property Var.Name: string

active recognizer NewUnionCase: Expr -> (Reflection.UnionCaseInfo * Expr list) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |NewUnionCase|_| )

val uci : Reflection.UnionCaseInfo

val args : Expr list

property Reflection.UnionCaseInfo.Name: string

val printArgs : depth:int -> args:Expr list -> string

Full name: Script.QuotationPrinter.printArgs

active recognizer NewArray: Expr -> (Type * Expr list) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |NewArray|_| )

active recognizer NewRecord: Expr -> (Type * Expr list) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |NewRecord|_| )

active recognizer NewTuple: Expr -> Expr list option

Full name: Microsoft.FSharp.Quotations.Patterns.( |NewTuple|_| )

active recognizer NewObject: Expr -> (Reflection.ConstructorInfo * Expr list) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |NewObject|_| )

val ci : Reflection.ConstructorInfo

active recognizer Call: Expr -> (Expr option * Reflection.MethodInfo * Expr list) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |Call|_| )

union case Option.Some: Value: 'T -> Option<'T>

active recognizer ValueWithName: Expr -> (obj * Type * string) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |ValueWithName|_| )

val instance : string

val mi : Reflection.MethodInfo

union case Option.None: Option<'T>

active recognizer Lambda: Expr -> (Var * Expr) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |Lambda|_| )

val var : Var

val body : Expr

static member Expr.Var : variable:Var -> Expr

active recognizer Let: Expr -> (Var * Expr * Expr) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |Let|_| )

val bind : Expr

active recognizer PropertyGet: Expr -> (Expr option * Reflection.PropertyInfo * Expr list) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |PropertyGet|_| )

val var : Expr

val pi : Reflection.PropertyInfo

active recognizer PropertySet: Expr -> (Expr option * Reflection.PropertyInfo * Expr list * Expr) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |PropertySet|_| )

val value : Expr

active recognizer Sequential: Expr -> (Expr * Expr) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |Sequential|_| )

val x : Expr

val y : Expr

val a : Expr

val failwithf : format:Printf.StringFormat<'T,'Result> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.failwithf

val a : Expr list

Multiple items
type String =
  new : value:char -> string + 7 overloads
  member Chars : int -> char
  member Clone : unit -> obj
  member CompareTo : value:obj -> int + 1 overload
  member Contains : value:string -> bool
  member CopyTo : sourceIndex:int * destination:char[] * destinationIndex:int * count:int -> unit
  member EndsWith : value:string -> bool + 2 overloads
  member Equals : obj:obj -> bool + 2 overloads
  member GetEnumerator : unit -> CharEnumerator
  member GetHashCode : unit -> int
  ...

Full name: System.String

--------------------
String(value: nativeptr<char>) : unit
String(value: nativeptr<sbyte>) : unit
String(value: char []) : unit
String(c: char, count: int) : unit
String(value: nativeptr<char>, startIndex: int, length: int) : unit
String(value: nativeptr<sbyte>, startIndex: int, length: int) : unit
String(value: char [], startIndex: int, length: int) : unit
String(value: nativeptr<sbyte>, startIndex: int, length: int, enc: Text.Encoding) : unit

String.Join(separator: string, values: Collections.Generic.IEnumerable<string>) : string
String.Join<'T>(separator: string, values: Collections.Generic.IEnumerable<'T>) : string
String.Join(separator: string, [<ParamArray>] values: obj []) : string
String.Join(separator: string, [<ParamArray>] value: string []) : string
String.Join(separator: string, value: string [], startIndex: int, count: int) : string

Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member GetSlice : startIndex:int option * endIndex:int option -> 'T list
  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

val enableFSI : unit -> unit

Full name: Script.QuotationPrinter.enableFSI

module QuotationPrinter

from Script

Next Version Raw view Test code New version

More information

Link:	http://fssnip.net/7OG
Posted:	8 years ago
Author:	Colin Bull
Tags:	quotations