0 people like it.
Like the snippet!

Substituting names

An example that shows how we can represent unique names (using classes) and how to substitute names in any F# type type defined using records, discriminated unions and tuples.

 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: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
75: 
76: 
77:

// F# uses object-oriented 'reference equality' when 
// comparing types defined as classes (but functional
// style structural equality for ADTs)
type Name() = 
  class end

// So we can use '=' to test whether two names are equal
let eq n1 n2 = n1 = n2

let n1 = Name()
let n2 = Name()
eq n1 n1 // true
eq n1 n2 // false


// Function that works on any F# (and .NET) type can be
// implemented using reflection mechanism (which is quite
// powerful, but it is based on .NET so it is not very
// elegant and also not very efficient)
open Microsoft.FSharp.Reflection

// A function that replaces all occurrences of 'n1' in 'any' with 'n2'
let rec sw<'a> (n1:Name) (n2:Name) (any:'a) : 'a =
  // Get the run-time representation of the type of 'any'
  let typ = any.GetType()
  // If it is a Name, then check if it equals 'n1' and substitute
  if typ = typeof<Name> then
    // We know that it is 'Name', but we need to convert the type
    // from 'a to Name (using 'unbox') and then back using 'box'
    // and downcast operator (:?>)
    let asName = unbox<Name> any
    if asName = n1 then (box n2) :?> 'a else any
  // If it is a record, walk over all fields recursively
  elif FSharpType.IsRecord(typ) then
    let fields = FSharpValue.GetRecordFields(any)
    let fields' = fields |> Array.map (sw<_> n1 n2) 
    FSharpValue.MakeRecord(typ, fields') :?> 'a
  // Dtto for unions and tuples
  elif FSharpType.IsUnion(typ) then
    let case, fields = FSharpValue.GetUnionFields(any, typ)
    let fields' = fields |> Array.map (sw<_> n1 n2)
    FSharpValue.MakeUnion(case, fields') :?> 'a
  elif FSharpType.IsTuple(typ) then
    let fields = FSharpValue.GetTupleFields(any)
    let fields' = fields |> Array.map (sw<_> n1 n2)
    FSharpValue.MakeTuple(fields', typ) :?> 'a
  // Not sure what to do when the value is a function (?)
  elif FSharpType.IsFunction(typ) then
    failwith "Function values are not supported"
  // If it is a primitive type, just return the original
  elif typ.IsValueType || typ = typeof<string> then 
    any
  // This also does not support classes (and types defined
  // in .NET libraries), which would make it uglier
  else
    failwithf ".NET types are not supported %A" typ.Name


// Sample representation of expressions using F# record & union
type BinaryInfo = 
  { Op : string
    Left : Expr 
    Right : Expr }

and Expr =
  | Var of Name
  | Binary of BinaryInfo

// If we replace 'n1' with 'n2' in 'sample1' then we
// should get a value that will be equal to 'sample2'
let sample1 =
  (Binary { Op = "+"; Left = Var n1; Right = Var n1 })
let sample2 =
  (Binary { Op = "+"; Left = Var n2; Right = Var n2 })

sw n1 n2 sample1 = sample1 // false 
sw n1 n2 sample1 = sample2 // true

Multiple items
type Name =
new : unit -> Name

Full name: Script.Name

--------------------
new : unit -> Name

val eq : n1:'a -> n2:'a -> bool (requires equality)

Full name: Script.eq

val n1 : 'a (requires equality)

val n2 : 'a (requires equality)

val n1 : Name

Full name: Script.n1

val n2 : Name

Full name: Script.n2

namespace Microsoft

namespace Microsoft.FSharp

namespace Microsoft.FSharp.Reflection

val sw : n1:Name -> n2:Name -> any:'a -> 'a

Full name: Script.sw

val n1 : Name

val n2 : Name

val any : 'a

val typ : System.Type

System.Object.GetType() : System.Type

val typeof<'T> : System.Type

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

val asName : Name

val unbox : value:obj -> 'T

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

val box : value:'T -> obj

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

type FSharpType =
  static member GetExceptionFields : exceptionType:Type * ?bindingFlags:BindingFlags -> PropertyInfo []
  static member GetFunctionElements : functionType:Type -> Type * Type
  static member GetRecordFields : recordType:Type * ?bindingFlags:BindingFlags -> PropertyInfo []
  static member GetTupleElements : tupleType:Type -> Type []
  static member GetUnionCases : unionType:Type * ?bindingFlags:BindingFlags -> UnionCaseInfo []
  static member IsExceptionRepresentation : exceptionType:Type * ?bindingFlags:BindingFlags -> bool
  static member IsFunction : typ:Type -> bool
  static member IsModule : typ:Type -> bool
  static member IsRecord : typ:Type * ?bindingFlags:BindingFlags -> bool
  static member IsTuple : typ:Type -> bool
  ...

Full name: Microsoft.FSharp.Reflection.FSharpType

static member FSharpType.IsRecord : typ:System.Type * ?allowAccessToPrivateRepresentation:bool -> bool
static member FSharpType.IsRecord : typ:System.Type * ?bindingFlags:System.Reflection.BindingFlags -> bool

val fields : obj []

type FSharpValue =
  static member GetExceptionFields : exn:obj * ?bindingFlags:BindingFlags -> obj []
  static member GetRecordField : record:obj * info:PropertyInfo -> obj
  static member GetRecordFields : record:obj * ?bindingFlags:BindingFlags -> obj []
  static member GetTupleField : tuple:obj * index:int -> obj
  static member GetTupleFields : tuple:obj -> obj []
  static member GetUnionFields : value:obj * unionType:Type * ?bindingFlags:BindingFlags -> UnionCaseInfo * obj []
  static member MakeFunction : functionType:Type * implementation:(obj -> obj) -> obj
  static member MakeRecord : recordType:Type * values:obj [] * ?bindingFlags:BindingFlags -> obj
  static member MakeTuple : tupleElements:obj [] * tupleType:Type -> obj
  static member MakeUnion : unionCase:UnionCaseInfo * args:obj [] * ?bindingFlags:BindingFlags -> obj
  ...

Full name: Microsoft.FSharp.Reflection.FSharpValue

static member FSharpValue.GetRecordFields : record:obj * ?allowAccessToPrivateRepresentation:bool -> obj []
static member FSharpValue.GetRecordFields : record:obj * ?bindingFlags:System.Reflection.BindingFlags -> obj []

val fields' : obj []

module Array

from Microsoft.FSharp.Collections

val map : mapping:('T -> 'U) -> array:'T [] -> 'U []

Full name: Microsoft.FSharp.Collections.Array.map

static member FSharpValue.MakeRecord : recordType:System.Type * values:obj [] * ?allowAccessToPrivateRepresentation:bool -> obj
static member FSharpValue.MakeRecord : recordType:System.Type * values:obj [] * ?bindingFlags:System.Reflection.BindingFlags -> obj

static member FSharpType.IsUnion : typ:System.Type * ?allowAccessToPrivateRepresentation:bool -> bool
static member FSharpType.IsUnion : typ:System.Type * ?bindingFlags:System.Reflection.BindingFlags -> bool

val case : UnionCaseInfo

static member FSharpValue.GetUnionFields : value:obj * unionType:System.Type * ?allowAccessToPrivateRepresentation:bool -> UnionCaseInfo * obj []
static member FSharpValue.GetUnionFields : value:obj * unionType:System.Type * ?bindingFlags:System.Reflection.BindingFlags -> UnionCaseInfo * obj []

static member FSharpValue.MakeUnion : unionCase:UnionCaseInfo * args:obj [] * ?allowAccessToPrivateRepresentation:bool -> obj
static member FSharpValue.MakeUnion : unionCase:UnionCaseInfo * args:obj [] * ?bindingFlags:System.Reflection.BindingFlags -> obj

static member FSharpType.IsTuple : typ:System.Type -> bool

static member FSharpValue.GetTupleFields : tuple:obj -> obj []

static member FSharpValue.MakeTuple : tupleElements:obj [] * tupleType:System.Type -> obj

static member FSharpType.IsFunction : typ:System.Type -> bool

val failwith : message:string -> 'T

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

property System.Type.IsValueType: bool

Multiple items
val string : value:'T -> string

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

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string

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

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

property System.Reflection.MemberInfo.Name: string

type BinaryInfo =
  {Op: string;
   Left: Expr;
   Right: Expr;}

Full name: Script.BinaryInfo

BinaryInfo.Op: string

BinaryInfo.Left: Expr

type Expr =
| Var of Name
| Binary of BinaryInfo

Full name: Script.Expr

BinaryInfo.Right: Expr

union case Expr.Var: Name -> Expr

union case Expr.Binary: BinaryInfo -> Expr

val sample1 : Expr

Full name: Script.sample1

val sample2 : Expr

Full name: Script.sample2

Raw view Test code New version

More information

Link:	http://fssnip.net/fm
Posted:	12 years ago
Author:	Tomas Petricek
Tags:	names , reflection