技術memo

関数型ゴースト

F# でリフレクション/式木に触れてみる

前置き

F# Advent Calendar 2013 8日目の記事になります。

昨日の記事は@brother_nomuさんの「F# で Oracle にアクセスしてみたよ!」でした。

ということで、F# を9月に始めて3ヶ月、ちょっとは関数型プログラミングにも慣れてきましたC#er な私です。 F# に関する質問や疑問をぽつぽつと喋っていたところ、気がついたらAdvent Calendarに記事を書くことになっていました。間違いなく孔明の罠ですね……。

今回の記事

Microsoft.FSharp.Reflection 名前空間の話はしません。今回扱うのは、System.Reflection 名前空間の話です。

「リフレクション」

知ってる人には常識、釈迦に説法・親父に説教な話ではありますが、「リフレクション」というものがあります。 これを使うと、プログラムの動作時になってから型の情報で

  • 何のメソッドやプロパティがあるか調べる
  • 指定した名前のプロパティの値を取得する

などができます。

「だから何?」

実際、インターフェースやジェネリクスで済ませられるところはそうした方が安全ですし、ラクです。 しかし、静的型な言語の面倒なところですが、「任意の型に共通した処理」というのは書きづらいものです。 例えば

  • 色々なオブジェクトのすべてのプロパティを取得してログに書き出す
  • 指定した属性(Attribute)を持ったメソッドを探して呼び出す
  • インターフェースは特に継承していないけれど特定の名前のメソッドを呼び出す(ダックタイピング)
  • XMLファイル(etc...)で指定したプロパティ名を使って画面に表示したい(データバインディング)
  • 指定した型のオブジェクトを生成して、複数のプロパティに値をセットしたい(O/Rマッパー)

などなど。 静的型により守られた安全な部分から、一歩踏み出すための手段というわけです。 しかし、実際には「ライブラリ書く人くらいしか使わない」のも実情だったりします。 それは何故か。ひとえに「難しく」て「メンドクサイから」です。

「それで今回の記事は?」

.Net Frameworkでリフレクションを扱うのは微妙にメンドクサイ。あと敷居が高い。 ならどうするか。パターンが決まってるなら定型処理にしてしまえばいいじゃない。 そう、ユーティリティあるいはライブラリのようなものにしてみましょう。

概略

今回扱うのは、

これらを

  • System.Reflection名前空間のクラスを使って行う
  • System.Linq.Expressionsのクラスを使って高速化してみる

この二本立てです。地味にボリューム重いです。

リフレクション編

型の動的読み込み

さくさく行きましょう。ざっくり言って方法は2パターン。System.Reflection.Assembly.GetTypeメソッドを使うか、System.Type.GetTypeメソッドを使うかです。

open System
open System.Reflection

// アセンブリ名と型名を指定して型を取得
let loadByAsm (assemblyName:string) (typeName:string) = Assembly.Load(assemblyName).GetType(typeName, true, false)

// 型名を取得して型を取得
let loadByType (typeName:string) = Type.GetType(typeName, true, false)

ジェネリック型の動的読み込み

ちょっとメンドクサイのがジェネリック型。クラス名に< T>(※C#) とか<'T>(※F#)とかついてるアレです。 手順としては、

  • 読み込む型名を加工…… HogeClass<T1, T2>なら"HogeClass`2"のようになります
  • 加工後の型名でTypeオブジェクトを取得
  • 型引数に実際の型を当てはめて完成

といった工程になります。

// ジェネリック型の場合、型名を加工
let toGenericTypeName (typeName:string) (typeArgsCount:int) =
   String.Format("{0}`{1}", typeName, typeArgsCount)// sprintfにした方がいいかも?

// アセンブリからジェネリック型を取得
let loadGenericByAsm assemblyName typeName (typeArgs:Type seq) =
   let tArgsArray = Seq.toArray typeArgs
   let t = loadByAsm assemblyName (toGenericTypeName typeName tArgsArray.Length)// 型名を加工してから、読み込み
   t.MakeGenericType(tArgsArray)// ジェネリック引数を適用

// Typeからジェネリック型を取得
let loadGenericByType typeName (typeArgs:Type seq) =
   let tArgsArray = Seq.toArray typeArgs
   let t = loadByType (toGenericTypeName typeName tArgsArray.Length)// 型名を加工してから、読み込み
   t.MakeGenericType(tArgsArray)// ジェネリック引数を適用

これで、System.Typeオブジェクトが取得できます。

メソッド呼び出し

手順は

といった感じです。

// MethodInfoを取得
let getInfo_ (t:Type) (binding:BindingFlags) (methodName:string) (isGeneric:bool) (paramTypes:Type []) =
   t.GetMethod(methodName, binding, null, paramTypes, null)// MethodInfo取得 … これでうまくいきそう?

ちょっとここでストップです。 例えば次のようなクラスがあったらどうでしょう(C#です)

class Hoge
{
  void HogeMethod(int i){ }
  void HogeMethod<T>(int i){ }
}

中身は適当ですが、問題は「メソッド名と引数の数と順番が全て一致するメソッド複数ある」場合です。 このようなメソッドに対してGetMethodを呼び出すとどうなるか。 困ったことに実行時エラーになります。

ではどうするか。ちょっと手間はかかりますが、まとめて取得して条件で絞り込みましょう。

// ヘルパー関数
let inline seqEqual x y = System.Linq.Enumerable.SequenceEqual(x, y)

// MethodInfoを取得
let getInfo (t:Type) (binding:BindingFlags) (methodName:string) (isGeneric:bool) (paramTypes:Type []) =
   t.GetMethods(binding)
      |> Seq.filter begin fun x ->
            x.IsGenericMethod = isGeneric
            && x.Name = methodName
            && (x.GetParameters() |> Seq.map(fun x -> x.ParameterType) |> seqEqual paramTypes)
         end
      |> Seq.nth 0

これで条件は

に増えます。ここまでやればたぶん大丈夫でしょう。 そして流石に速度が気になるのでメモ化しておきます。

// ヘルパー関数
let inline curry5 f a b c d e = f (a, b, c, d, e)
let inline uncurry5 f (a, b, c, d, e) = f a b c d e
let memoizeSafe<'TA, 'TR when 'TA:equality> f =
   let cache = new System.Collections.Concurrent.ConcurrentDictionary<'TA,'TR>()
   fun p -> cache.TryGetValue p |> function | true, r -> r | _ -> let r = f p in cache.TryAdd(p, r) |> ignore; r
let memoizeSafe5<'TA1, 'TA2, 'TA3, 'TA4, 'TA5, 'TR when 'TA1:equality and 'TA2:equality and 'TA3:equality and 'TA4:equality and 'TA5:equality> f =
   f |> uncurry5 |> memoizeSafe<'TA1*'TA2*'TA3*'TA4*'TA5, 'TR> |> curry5

// MethodInfoを取得
let getInfo = memoizeSafe5 begin fun (t:Type) (binding:BindingFlags) (methodName:string) (isGeneric:bool) (paramTypes:Type list) ->
   t.GetMethods(binding)
      |> Seq.filter begin fun x ->
            x.IsGenericMethod = isGeneric
            && x.Name = methodName
            && (x.GetParameters() |> Seq.map(fun x -> x.ParameterType) |> seqEqual paramTypes)
         end
      |> Seq.nth 0
end
// 地味にparamTypesの型がType []からType listに変わってるのはメモ化時に「リストの構造的等価」で比較してほしいからという問題が……

あとはメソッド呼び出しだけですね。

// ヘルパー関数
let inline nullToEmpty xs = match xs with | null -> Seq.empty | _ -> xs

// MethodInfoからメソッドを実行
let call_ (mi:MethodInfo) (instance:obj) (parameters:obj []) =
   mi.Invoke(instance, parameters)

// メソッドを実行
let call t binding instance methodName (parameters:seq<obj*Type>) =
   let paramsArray = parameters |> nullToEmpty |> Seq.toArray |> Array.unzip
   let mi  = getInfo t binding methodName false (paramsArray |> snd |> List.ofArray)// MethodInfoを取得
   call_ mi instance (fst paramsArray)// メソッド実行
// parametersの型がseq<obj*Type>なのは苦肉の策。引数の値とその型のペアのリスト、です。

// 苦肉の策に、自動的にオブジェクトの列挙から「値と型のペア」のリストに変換するヘルパ関数も提供
let getParamTypes parameters =
   parameters |> Seq.map begin fun x-> (box x, x.GetType()) end// x=nullだと失敗します

ジェネリック メソッド呼び出し

手順は通常のメソッド呼び出しの手順が一個増えるだけです。

こちらも見ていきましょう

// ジェネリックメソッドのMethodInfoを取得
let getGenericInfo (t:Type) (binding:BindingFlags) (methodName:string) (typeArgs:Type []) (paramTypes:Type list) =
   let mi  = getInfo t binding methodName true paramTypes
   mi.MakeGenericMethod(typeArgs)

// ジェネリックメソッドを実行
let callGeneric t binding instance methodName typeArgs (parameters:seq<obj*Type>) =
   let paramsArray = parameters |> nullToEmpty |> Array.ofSeq |> Array.unzip
   let gmi = getGenericInfo t binding methodName typeArgs (paramsArray |> snd |> List.ofArray)
   call_ gmi instance (fst paramsArray)

プロパティ書込/読取

こちらもやることはメソッドと大差ありません。

  • TypeオブジェクトからPropertyInfoを取得する
  • PropertyInfoに「書込/読取に使うインスタンス(staticメソッドならnull)」を渡してSet/Get

といった感じです。こちらはジェネリックで重複が云々は……考えなくても大丈夫でしょう。

// PropertyInfoを取得
let getInfo (t:Type) (binding:BindingFlags) (propertyName:string) =
   t.GetProperty(propertyName, binding)

// PropertyInfoからプロパティ値設定
let set_ (pi:PropertyInfo) (instance:obj) (value:obj) =
   pi.SetValue(instance, value)

// PropertyInfoからプロパティ値取得
let get_ (pi:PropertyInfo) (instance:obj) =
   pi.GetValue(instance)

// プロパティ値設定
let set t binding instance propertyName value =
   let pi = getInfo t binding propertyName
   set_ pi instance value

// プロパティ値取得
let get t binding instance propertyName =
   let pi = getInfo t binding propertyName
   get_ pi instance

全部のプロパティにアクセスしたい

そういう話もありますよね。さくっとやってみましょう

// プロパティ値一括取得(一般)
let getValues_<'T> (t:Type) (binding:BindingFlags) (predicate:(PropertyInfo->bool)) (getProperty:PropertyInfo->'T) =
   t.GetProperties(binding) |> Seq.filter predicate |> Seq.map getProperty

// プロパティ値一括取得(名前と値のペア)
let getValues (t:Type) (binding:BindingFlags) (instance:obj) (predicate:(PropertyInfo->bool)) =
   getValues_ t binding begin fun x -> x.CanRead && predicate x end begin fun x -> (x.Name, get_ x instance) end

フィールドは?

PropertyInfoがFieldInfoになるだけでほとんどプロパティと変わらないので、コードだけ置いておきます。

// FieldInfo取得
let getInfo (t:Type) (binding:BindingFlags) (fieldName:string) =
   t.GetField(fieldName, binding)

// FieldInfoからフィールド値設定
let set_ (fi:FieldInfo) (instance:obj) (value:obj) =
   fi.SetValue(instance, value)

// FieldInfoからフィールド値取得
let get_ (fi:FieldInfo) (instance:obj) =
  fi.GetValue(instance)

// フィールド値設定
let set t binding instance fieldName value =
  let fi = getInfo t binding fieldName
  set_ fi instance value

// フィールド値取得
let get t binding instance fieldName =
  let fi = getInfo t binding fieldName
  get_ fi instance

// フィールド値一括取得(一般)
let getValues_<'T> (t:Type) (binding:BindingFlags) (predicate:(FieldInfo->bool)) (getField:FieldInfo->'T) =
  t.GetFields(binding) |> Seq.filter predicate |> Seq.map getField

// フィールド値一括取得(名前と値のペア)
let getValues (t:Type) (binding:BindingFlags) (instance:obj) (predicate:(FieldInfo->bool)) =
  getValues_ t binding predicate begin fun x -> (x.Name, get_ x instance) end

コンストラクタ

こちらも同様、ConstructorInfoを取得して引数を渡して実行!というだけです。注意点としては、BindingFlagにInstanceを指定すると普通のコンストラクタが、Staticを指定すると「クラス初期化子」が取得される、ということです。

// ConstructorInfoを取得
let getInfo (t:Type) (binding:BindingFlags) (paramTypes:Type seq) =
   t.GetConstructor(binding, null, (Array.ofSeq paramTypes), null)

// ConstructorInfoからコンストラクタを実行
let call_ (ci:ConstructorInfo) (parameters:obj []) =
   ci.Invoke(parameters)

// コンストラクタを実行
let call (t:Type) (parameters:seq<obj*Type>) =
   let paramsArray = parameters |> nullToEmpty |> Seq.toArray |> Array.unzip
   let ci = getInfo t Bindings.instances (snd paramsArray)// ConstructorInfoを取得(Bindings.instancesは次に出てきますがBindingFlags.Instance, Public, NonPublicです)
   call_ ci (fst paramsArray)// コンストラクタを実行

使ってみる

そろそろ実際のクラスに使ってみましょう。

// binding flags
module Bindings = begin
   let instances = BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance
   let statics = BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Static
end

// 上記では省略していましたが、実際にはメソッド/プロパティ/フィールド/コンストラクタでそれぞれモジュールとして切り分けたものとして書いています。
// 詳細は付録の実コードをご確認ください。

open System

// loading tests
let typeofString1 = Types.loadByAsm "mscorlib" "System.String"// string
let typeofStringList1 = Types.loadGenericByAsm "mscorlib" "System.Collections.Generic.List" (Seq.singleton typeof<string>)// List<string>
let typeofDict1 = Types.loadGenericByAsm "mscorlib" "System.Collections.Generic.Dictionary" [typeof<string>; typeof<obj>]// Dictionary<string, object>
let typeofString2 = Types.loadByType "System.String"// sring
let typeofStringList2 = Types.loadGenericByType "System.Collections.Generic.List" (Seq.singleton typeof<string>)// List<string>
let typeofDict2 = Types.loadGenericByType "System.Collections.Generic.Dictionary" [typeof<string>; typeof<obj>]// Dictionary<string, object>

// constructor tests
let str1 = Constructors.call typeof<string> (Seq.singleton [|'a'; 'b'; 'c'|] |> getParamTypes)// "abc"
let date1 = Constructors.call typeof<DateTime> ([2013; 12; 25] |> getParamTypes)// 2013/12/25 0:00:00

// class for test
type Test()=
   static let clsField1 = "** clsField1 **"
   static let clsField2 = 200
   static let mutable _clsProp1inner = "** clsProp1 **"
   // fields
   let mutable _prop3inner = 0
   let mutable field1 = "** field1 **"
   let mutable field2 = "** field2 **"
   let mutable field3 = 3
   // methods
   member v.func0 () = sprintf "func0"
   member v.func1 x = sprintf "func1:%s" x
   member v.func1<'T> x = sprintf "func1<'T>:%s ('T:%s)" x typeof<'T>.Name
   member v.func2 (x, y) = sprintf "func2:%s %s" x y
   member v.func2<'T1, 'T2> (x, y) = sprintf "func2<'T1, 'T2>:%s %s ('T1:%s 'T2:%s)" x y typeof<'T1>.Name typeof<'T2>.Name
   //properties
   member v.prop1 with get() = "** prop1 **"
   member v.prop2 with get() = "** prop2 **"
   member v.prop3 with get() = _prop3inner and set(x) = _prop3inner<-x
   member val prop4  = "** prop4 **" with get,set
   static member clsProp1 with get() = _clsProp1inner and set(x) = _clsProp1inner <-x

let testObj = new Test()

// methods tests
let m0 = Methods.call typeof<Test> Bindings.instances testObj "func0" (Seq.empty |> getParamTypes)// "func0"
let m1 = Methods.call typeof<Test> Bindings.instances testObj "func1" (Seq.singleton "aaa" |> getParamTypes)// "func1:aaa"
let m2 = Methods.call typeof<Test> Bindings.instances testObj "func2" (["aaa"; "bbb"] |> getParamTypes)// "func2:aaa bbb"
let gm1 = Methods.callGeneric typeof<Test> Bindings.instances testObj "func1" [|typeof<int>|] (Seq.singleton "aaa" |> getParamTypes)// "func1<'T>:aaa ('T:Int32)"
let gm2 = Methods.callGeneric typeof<Test> Bindings.instances testObj "func2" [|typeof<int>; typeof<string>|] (["aaa"; "bbb"] |> getParamTypes)// "func2<'T1, 'T2>:aaa bbb ('T1:Int32 'T2:String)"

// properties tests
let p1 = Properties.get typeof<Test> Bindings.instances testObj "prop1"// "** prop1 **"
let p2 = Properties.get typeof<Test> Bindings.instances testObj "prop2"/// "** prop2 **"
let p3_1 = Properties.get typeof<Test> Bindings.instances testObj "prop3"// 0
Properties.set typeof<Test> Bindings.instances testObj "prop3" (box 30)
let p3_2 = Properties.get typeof<Test> Bindings.instances testObj "prop3"// 30
let p4_1 = Properties.get typeof<Test> Bindings.instances testObj "prop4"// "** prop4 **"
Properties.set typeof<Test> Bindings.instances testObj "prop4" (box "!! prop4 !!")
let p4_2 = Properties.get typeof<Test> Bindings.instances testObj "prop4"// "!! prop4 !!"

// fields tests
let f1 = Fields.get typeof<Test> Bindings.instances testObj "field1"// "** field1 **"
let f2 = Fields.get typeof<Test> Bindings.instances testObj "field2"// "** field2 **"
let f3_1 = Fields.get typeof<Test> Bindings.instances testObj "field3"// 3
Fields.set typeof<Test> Bindings.instances testObj "field3" (box 40)
let f3_2 = Fields.get typeof<Test> Bindings.instances testObj "field3"// 40

// static field tests
let cp1 = Properties.get typeof<Test> Bindings.statics null "clsProp1"// "** clsProp1 **"
let cf1inner = Fields.get typeof<Test> Bindings.statics null "_clsProp1inner"// "** clsProp1 **"
let cf1_1 = Fields.get typeof<Test> Bindings.statics null "clsField1" //NG
let cf1_2 = Properties.get typeof<Test> Bindings.statics null "clsField1" //NG
let cf2_1 = Fields.get typeof<Test> Bindings.statics null "clsField2" //NG
let cf2_2 = Properties.get typeof<Test> Bindings.statics null "clsField2" //NG

見たところそれっぽく動いてそうですね。 ただ、最後にテストしたstatic letなフィールドがどうもエラーになるのが気になります。 内部的にはどうなっているのでしょう。constの扱いの問題だと思うのですが……。

式木?

動的コード生成の魔境、式木(System.Linq.Expressions)編、スタートです。 といっても触りだけ簡単に、それぞれのケースで****Infoから対応する式木を生成する程度にしておきます。

メソッド

MethodInfoから、対応する関数呼び出しを行うデリゲートを生成します。

// ヘルパ関数
let inline prependSingle x xs = seq{yield x; yield! xs;}
let getParameterTypes (mi:MethodInfo) =
   mi.GetParameters() |> Seq.map(fun x->x.ParameterType)

// MethodInfoのデリゲート生成
/// create expressions: (T target, TP1 p1, TP2 p2, ... , TPn pn)=>(target.SomeMethod(p1, p2, ... , pn))
let createCallingMethodEx<'TFunc> (methodInfo:MethodInfo) =
   let targetType = methodInfo.DeclaringType
   let target = Expression.Parameter(targetType, "target")
   let paramTypes = getParameterTypes methodInfo
   let paramsEx = paramTypes |> nullToEmpty |> Seq.mapi begin fun i x-> Expression.Parameter(x, "p" + i.ToString()) end |> Seq.toArray
   let ex = Expression.Lambda<'TFunc>(
               Expression.Call(target, methodInfo, (paramsEx |> Seq.cast<Expression>))
               , (prependSingle target paramsEx)
            )
   ex.Compile()

ここで厄介なのが型引数'TFuncで、ここにはSystem.Func<...>やSystem.Action<...>を指定してやる必要があります。 Expression.Lambda<'TFunc>のところで何も指定しないと、Compile()結果がSystem.Delegateになってしまい、DynamicInvokeしかできなくなってしまうので、高速化の意味ではちょっと微妙でしょう。 (MethodInfoの内容から'TFuncを動的にロードしてやってもよさそうですが……諸事情により割愛。)

プロパティ

メソッドができてしまえば、プロパティの方は一瞬で片付きます。プロパティはSetもGetもメソッドとして扱えるからです。

// PropertyInfoのデリゲート生成(Set)
// 'Tにはオブジェクト自身の型、'TVにはプロパティの型を指定します
let createSettingPropertyEx<'T, 'TV> (propertyInfo:PropertyInfo) =
   createCallingMethodEx<Action<'T, 'TV>> propertyInfo.SetMethod

// PropertyInfoのデリゲート生成(Get)
let createGettingPropertyEx<'T, 'TV> (propertyInfo:PropertyInfo) =
   createCallingMethodEx<Func<'T, 'TV>> propertyInfo.GetMethod

フィールド

フィールドはプロパティのようにラクできないので、地道に組み立てましょう。

// FieldInfoのデリゲート生成(Set)
// 'Tにはオブジェクト自身の型、'TVにはプロパティの型を指定します
/// create expressions: (T target, TP p)=>(target.someField = p)
let createSettingFieldEx<'T, 'TV> (fieldInfo:FieldInfo) =
   let targetType = fieldInfo.DeclaringType
   let target = Expression.Parameter(targetType, "target")
   let p = Expression.Parameter(fieldInfo.FieldType, "p")
   let ex = Expression.Lambda<Action<'T, 'TV>>(
               Expression.Assign(Expression.Field(target, fieldInfo), p)
               , [| target; p; |]
            )
   ex.Compile()

// FieldInfoのデリゲート生成(Get)
/// create expressions: (T target)=>(target.someField)
let createGettingFieldEx<'T, 'TV> (fieldInfo:FieldInfo) =
   let targetType = fieldInfo.DeclaringType
   let target = Expression.Parameter(targetType, "target")
   let ex = Expression.Lambda<Func<'T, 'TV>>(
               Expression.Field(target, fieldInfo)
               , target
            )
   ex.Compile()

コンストラクタ

黙々と式木を組みます。

// ヘルパー関数
let getParameterTypes (ci:ConstructorInfo) =
      ci.GetParameters() |> Seq.map(fun x->x.ParameterType)

// ConstructorInfoのデリゲート生成
/// create expressions: (TP1 p1, TP2 p2, ... , TPn pn)=>(new SomeClass(p1, p2, ... , pn))
let createConstructorEx<'TFunc> (constructorInfo:ConstructorInfo) =
   let paramTypes = getParameterTypes constructorInfo
   let paramsEx = paramTypes |> nullToEmpty |> Seq.mapi begin fun i x-> Expression.Parameter(x, "p" + i.ToString()) end |> Seq.toArray
   let ex = Expression.Lambda<'TFunc>(
               Expression.New(constructorInfo, (paramsEx |> Seq.ofArray |> Seq.cast<Expression>))
               , paramsEx
            )
   ex.Compile()

使ってみる

同様に式木版も動かしてみます。

// constructor tests
let exstr = createConstructorEx<Func<char [], string>> (Constructors.getInfo typeof<string> Bindings.instances ([typeof<char []>] |> Seq.ofList))
let exstr_result = exstr.Invoke([|'a'; 'b'; 'c'|])// "abc"

let exdate = createConstructorEx<Func<int, int, int, DateTime>> (Constructors.getInfo typeof<DateTime> Bindings.instances ([typeof<int>;typeof<int>;typeof<int>] |> Seq.ofList))
let exdate_result = exdate.Invoke(2013, 12, 25)// 2013/12/25 0:00:00

let testObj2 = new Test()

// method
let exm0 = createCallingMethodEx<Func<Test, string>> (Methods.getInfo typeof<Test> Bindings.instances "func0" false List.empty)
let exm0_result = exm0.Invoke(testObj2)// "func0"

let exm1 = createCallingMethodEx<Func<Test, string, string>> (Methods.getInfo typeof<Test> Bindings.instances "func1" false [typeof<string>])
let exm1_result = exm1.Invoke(testObj2, "aaa")// "func1:aaa"

let exgm1 = createCallingMethodEx<Func<Test, string, string>> (Methods.getGenericInfo typeof<Test> Bindings.instances "func1" [|typeof<int>|] [typeof<string>])
let exgm1_result = exgm1.Invoke(testObj2, "aaa")// "func1<'T>:aaa ('T:Int32)"

// property
let exp3get = createGettingPropertyEx<Test, int> (Properties.getInfo typeof<Test> Bindings.instances "prop3")
let exp3get_result = exp3get.Invoke(testObj2)// 0

let exp3set = createSettingPropertyEx<Test, int> (Properties.getInfo typeof<Test> Bindings.instances "prop3")
let exp3set_result = exp3set.Invoke(testObj2, 50)
let exp3get2_result = exp3get.Invoke(testObj2) // 50

// field
let exf3get = createGettingFieldEx<Test, int> (Fields.getInfo typeof<Test> Bindings.instances "field3")
let exf3get_result = exf3get.Invoke(testObj2)// 3

let exf3set = createSettingFieldEx<Test, int> (Fields.getInfo typeof<Test> Bindings.instances "field3")
let exf3set_result = exf3set.Invoke(testObj2, 60)
let exf3get2_result = exf3get.Invoke(testObj2) // 60

どうやら無事動きそうですね

まとめ

「結局やっぱりメンドクサイんじゃない?」「C#でdynamicキーワード使った方がマシ」

薄い補助関数群を定義した程度なので、結局メンドクサイのは確かですね。 dynamicキーワードで対応できないケース、例えば「呼び出すメソッド名の文字列を動的に指定したり」などは、こうして対応するしかありません。 後はMethodInfo等をわずかでも触ろうと思えば厳しい。 例えば今回の全プロパティの値を列挙する処理などは、PropertyInfoの一覧を取る必要があります。 今回のコードの関数呼び出しに関して書き方が面倒(引数にいちいち「typeof Bindings.instances testObj」などと並ぶ)ことには、実はある程度解決方法に目処が立っているのですが、諸事情により省略。

「式木組んでコンパイルとか初回処理遅いんじゃないの?」

実際そうらしいです(伝聞)。詳しくはSystem.Diagnostics.Stopwatchクラスでも使ってベンチマーク取りましょう。 「初回呼び出し時にレスポンスを返しつつ、バックグラウンドでデリゲート生成」みたいなものも、作りかけましたが、諸事情により省略。

「式木のキャッシュってどうやったらいいの?」

呼び出すメソッド等の種類によって、ActionやFuncの型が違ってしまうのが困りものなんですよね。 その辺をユーザに意識させない作りにできたら、使い勝手良いんじゃないかと思います……(今後の課題とします)。

「それhogefugaでできるよ」(CallSite, DynamicObject, etc.)

難しいことよくわかりません!

「それF#でやる意味あるの?」

F#だけで完結するプロジェクトなら、System.Reflectionよりは、Microsoft.FSharp.Reflectionの方を扱うことが圧倒的に多いと思います。クラスを定義するのもeasyな言語ですが、それ以上にタプルやレコード、判別共用体の適用範囲が広いためです。 次に、まず既存の.Net Frameworkや、その他(C#などで書かれた)ライブラリのクラスに対して使う場合。但し、この場合はさほど有効とはいえないでしょう。せいぜいprivateやprotectedなフィールドにアクセスしに行く程度です。 最後に、C#のプロジェクトから利用する場合。この場合はもうちょっと利用しやすさを考えてCompiledNameを付けたり拡張メソッドにしたり工夫が必要そうです。 こうしてみると「ならC#で書けば」と思いますが……しかしです、(↓続く)

感想など

関数型言語でライブラリを書く」ということ自体は、かなりメリットがあるように感じました。 不変な束縛や、容易な関数合成など、簡潔で保守性の高いコードを書ける環境がそろっています。 今回はレコードや判別共用体までは持ち出しませんでしたけど、そのあたりも使い出がありそうです。

参考記事

最後に

この記事はF# Advent Calendar 2013 8日目の記事でした。 明日の記事は@bleisさんの「.NETの標準ライブラリと仲良くする話」です。

付録 掲載分の実装コードまとめ

[blog.fs]

namespace RflcEx

open System
open System.Reflection

[<AutoOpen>]
module Core = begin
   let inline curry f a b = f (a, b)
   let inline curry3 f a b c = f (a, b, c)
   let inline curry4 f a b c d = f (a, b, c, d)
   let inline curry5 f a b c d e = f (a, b, c, d, e)
   let inline uncurry f (a, b) = f a b
   let inline uncurry3 f (a, b, c) = f a b c
   let inline uncurry4 f (a, b, c, d) = f a b c d
   let inline uncurry5 f (a, b, c, d, e) = f a b c d e
   let inline seqEqual x y = System.Linq.Enumerable.SequenceEqual(x, y)
   let inline nullToEmpty xs = match xs with | null -> Seq.empty | _ -> xs
   let inline prependSingle x xs = seq{yield x; yield! xs;}
   let inline appendSingle xs x = seq{yield! xs; yield x;}
   let memoizeSafe<'TA, 'TR when 'TA:equality> f =
      let cache = new System.Collections.Concurrent.ConcurrentDictionary<'TA,'TR>()
      fun p -> cache.TryGetValue p |> function | true, r -> r | _ -> let r = f p in cache.TryAdd(p, r) |> ignore; r
   let memoizeSafe2<'TA1, 'TA2, 'TR when 'TA1:equality and 'TA2:equality> f =
      f |> uncurry |> memoizeSafe<'TA1*'TA2, 'TR> |> curry
   let memoizeSafe3<'TA1, 'TA2, 'TA3, 'TR when 'TA1:equality and 'TA2:equality and 'TA3:equality> f =
      f |> uncurry3 |> memoizeSafe<'TA1*'TA2*'TA3, 'TR> |> curry3
   let memoizeSafe4<'TA1, 'TA2, 'TA3, 'TA4, 'TR when 'TA1:equality and 'TA2:equality and 'TA3:equality and 'TA4:equality> f =
      f |> uncurry4 |> memoizeSafe<'TA1*'TA2*'TA3*'TA4, 'TR> |> curry4
   let memoizeSafe5<'TA1, 'TA2, 'TA3, 'TA4, 'TA5, 'TR when 'TA1:equality and 'TA2:equality and 'TA3:equality and 'TA4:equality and 'TA5:equality> f =
      f |> uncurry5 |> memoizeSafe<'TA1*'TA2*'TA3*'TA4*'TA5, 'TR> |> curry5
   let getParamTypes parameters =
      parameters |> Seq.map begin fun x-> (box x, x.GetType()) end
end


// binding flags
module Bindings = begin
   let instances = BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance
   let statics = BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Static
end

// Type Loading
module Types = begin
   // アセンブリ名と型名を指定して型を取得
   let loadByAsm (assemblyName:string) (typeName:string) = Assembly.Load(assemblyName).GetType(typeName, true, false)

   // 型名を取得して型を取得
   let loadByType (typeName:string) = Type.GetType(typeName, true, false)

   // ジェネリック型の場合、型名を加工
   let toGenericTypeName (typeName:string) (typeArgsCount:int) =
      String.Format("{0}`{1}", typeName, typeArgsCount)

   // アセンブリからジェネリック型を取得
   let loadGenericByAsm assemblyName typeName (typeArgs:Type seq) =
      let tArgsArray = Seq.toArray typeArgs
      let t = loadByAsm assemblyName (toGenericTypeName typeName tArgsArray.Length)
      t.MakeGenericType(tArgsArray)

   // Typeからジェネリック型を取得
   let loadGenericByType typeName (typeArgs:Type seq) =
      let tArgsArray = Seq.toArray typeArgs
      let t = loadByType (toGenericTypeName typeName tArgsArray.Length)
      t.MakeGenericType(tArgsArray)
end


// Methods
module Methods = begin
   // MethodInfoのパラメータの型のリストを取得する
   let getParameterTypes (mi:MethodInfo) =
      mi.GetParameters() |> Seq.map(fun x->x.ParameterType)

   // MethodInfoを取得
   let getInfo_ (t:Type) (binding:BindingFlags) (methodName:string) (isGeneric:bool) (paramTypes:Type []) =
      t.GetMethod(methodName, binding, null, paramTypes, null)

   // MethodInfoを取得
   let getInfo = memoizeSafe5 begin fun (t:Type) (binding:BindingFlags) (methodName:string) (isGeneric:bool) (paramTypes:Type list) ->
      t.GetMethods(binding)
         |> Seq.filter begin fun x ->
               x.IsGenericMethod = isGeneric
               && x.Name = methodName
               && (x.GetParameters() |> Seq.map(fun x -> x.ParameterType) |> seqEqual paramTypes)
            end
         |> Seq.nth 0
   end
   // ジェネリックメソッドのMethodInfoを取得
   let getGenericInfo (t:Type) (binding:BindingFlags) (methodName:string) (typeArgs:Type []) (paramTypes:Type list) =
      let mi  = getInfo t binding methodName true paramTypes
      mi.MakeGenericMethod(typeArgs)

   // MethodInfoからメソッドを実行
   let call_ (mi:MethodInfo) (instance:obj) (parameters:obj []) =
      mi.Invoke(instance, parameters)

   // ジェネリックメソッドを実行
   let callGeneric t binding instance methodName typeArgs (parameters:seq<obj*Type>) =
      let paramsArray = parameters |> nullToEmpty |> Array.ofSeq |> Array.unzip
      let gmi = getGenericInfo t binding methodName typeArgs (paramsArray |> snd |> List.ofArray)
      call_ gmi instance (fst paramsArray)

   // メソッドを実行
   let call t binding instance methodName (parameters:seq<obj*Type>) =
      let paramsArray = parameters |> nullToEmpty |> Seq.toArray |> Array.unzip
      let mi  = getInfo t binding methodName false (paramsArray |> snd |> List.ofArray)
      call_ mi instance (fst paramsArray)
end

// Properties
module Properties = begin
   // PropertyInfoを取得
   let getInfo (t:Type) (binding:BindingFlags) (propertyName:string) =
      t.GetProperty(propertyName, binding)

   // PropertyInfoからプロパティ値設定
   let set_ (pi:PropertyInfo) (instance:obj) (value:obj) =
      pi.SetValue(instance, value)

   // PropertyInfoからプロパティ値取得
   let get_ (pi:PropertyInfo) (instance:obj) =
      pi.GetValue(instance)

   // プロパティ値設定
   let set t binding instance propertyName value =
      let pi = getInfo t binding propertyName
      set_ pi instance value

   // プロパティ値取得
   let get t binding instance propertyName =
      let pi = getInfo t binding propertyName
      get_ pi instance

   // プロパティ値一括取得(一般)
   let getValues_<'T> (t:Type) (binding:BindingFlags) (predicate:(PropertyInfo->bool)) (getProperty:PropertyInfo->'T) =
      t.GetProperties(binding) |> Seq.filter predicate |> Seq.map getProperty

   // プロパティ値一括取得(名前と値のペア)
   let getValues (t:Type) (binding:BindingFlags) (instance:obj) (predicate:(PropertyInfo->bool)) =
      getValues_ t binding begin fun x -> x.CanRead && predicate x end begin fun x -> (x.Name, get_ x instance) end
end

// Fields
module Fields = begin
   // FieldInfo取得
   let getInfo (t:Type) (binding:BindingFlags) (fieldName:string) =
      t.GetField(fieldName, binding)

   // FieldInfoからフィールド値設定
   let set_ (fi:FieldInfo) (instance:obj) (value:obj) =
      fi.SetValue(instance, value)

   // FieldInfoからフィールド値取得
   let get_ (fi:FieldInfo) (instance:obj) =
      fi.GetValue(instance)

   // フィールド値設定
   let set t binding instance fieldName value =
      let fi = getInfo t binding fieldName
      set_ fi instance value

   // フィールド値取得
   let get t binding instance fieldName =
      let fi = getInfo t binding fieldName
      get_ fi instance

   // フィールド値一括取得(一般)
   let getValues_<'T> (t:Type) (binding:BindingFlags) (predicate:(FieldInfo->bool)) (getField:FieldInfo->'T) =
      t.GetFields(binding) |> Seq.filter predicate |> Seq.map getField

   // フィールド値一括取得(名前と値のペア)
   let getValues (t:Type) (binding:BindingFlags) (instance:obj) (predicate:(FieldInfo->bool)) =
      getValues_ t binding predicate begin fun x -> (x.Name, get_ x instance) end
end

// Constructor
module Constructors = begin
   // ConstructorInfoを取得
   let getInfo (t:Type) (binding:BindingFlags) (paramTypes:Type seq) =
      t.GetConstructor(binding, null, (Array.ofSeq paramTypes), null)

   // ConstructorInfoのパラメータの型のリストを取得する
   let getParameterTypes (ci:ConstructorInfo) =
      ci.GetParameters() |> Seq.map(fun x->x.ParameterType)

   // ConstructorInfoからコンストラクタを実行
   let call_ (ci:ConstructorInfo) (parameters:obj []) =
      ci.Invoke(parameters)
 
   // コンストラクタを実行
   let call (t:Type) (parameters:seq<obj*Type>) =
      let paramsArray = parameters |> nullToEmpty |> Seq.toArray |> Array.unzip
      let ci = getInfo t Bindings.instances (snd paramsArray)
      call_ ci (fst paramsArray)
end

module Expressions = begin
   open System.Linq.Expressions
   // MethodInfoのデリゲート生成
   /// create expressions: (T target, TP1 p1, TP2 p2, ... , TPn pn)=>(target.SomeMethod(p1, p2, ... , pn))
   let createCallingMethodEx<'TFunc> (methodInfo:MethodInfo) =
      let targetType = methodInfo.DeclaringType
      let target = Expression.Parameter(targetType, "target")
      let paramTypes = Methods.getParameterTypes methodInfo
      let paramsEx = paramTypes |> nullToEmpty |> Seq.mapi begin fun i x-> Expression.Parameter(x, "p" + i.ToString()) end |> Seq.toArray
      let ex = Expression.Lambda<'TFunc>(
                  Expression.Call(target, methodInfo, (paramsEx |> Seq.cast<Expression>))
                  , (prependSingle target paramsEx)
               )
      ex.Compile()

   // PropertyInfoのデリゲート生成(Set)
   let createSettingPropertyEx<'T, 'TV> (propertyInfo:PropertyInfo) =
      createCallingMethodEx<Action<'T, 'TV>> propertyInfo.SetMethod

   // PropertyInfoのデリゲート生成(Get)
   let createGettingPropertyEx<'T, 'TV> (propertyInfo:PropertyInfo) =
      createCallingMethodEx<Func<'T, 'TV>> propertyInfo.GetMethod

   // FieldInfoのデリゲート生成(Set)
   /// create expressions: (T target, TP p)=>(target.someField = p)
   let createSettingFieldEx<'T, 'TV> (fieldInfo:FieldInfo) =
      let targetType = fieldInfo.DeclaringType
      let target = Expression.Parameter(targetType, "target")
      let p = Expression.Parameter(fieldInfo.FieldType, "p")
      let ex = Expression.Lambda<Action<'T, 'TV>>(
                  Expression.Assign(Expression.Field(target, fieldInfo), p)
                  , [| target; p; |]
               )
      ex.Compile()

   // FieldInfoのデリゲート生成(Get)
   /// create expressions: (T target)=>(target.someField)
   let createGettingFieldEx<'T, 'TV> (fieldInfo:FieldInfo) =
      let targetType = fieldInfo.DeclaringType
      let target = Expression.Parameter(targetType, "target")
      let ex = Expression.Lambda<Func<'T, 'TV>>(
                  Expression.Field(target, fieldInfo)
                  , target
               )
      ex.Compile()

   // ConstructorInfoのデリゲート生成
   /// create expressions: (TP1 p1, TP2 p2, ... , TPn pn)=>(new SomeClass(p1, p2, ... , pn))
   let createConstructorEx<'TFunc> (constructorInfo:ConstructorInfo) =
      let paramTypes = Constructors.getParameterTypes constructorInfo
      let paramsEx = paramTypes |> nullToEmpty |> Seq.mapi begin fun i x-> Expression.Parameter(x, "p" + i.ToString()) end |> Seq.toArray
      let ex = Expression.Lambda<'TFunc>(
                  Expression.New(constructorInfo, (paramsEx |> Seq.ofArray |> Seq.cast<Expression>))
                  , paramsEx
               )
      ex.Compile()
end

[blog.fsx]

#load "blog.fs"
open System
open RflcEx

// loading tests
let typeofString1 = Types.loadByAsm "mscorlib" "System.String"// string
let typeofStringList1 = Types.loadGenericByAsm "mscorlib" "System.Collections.Generic.List" (Seq.singleton typeof<string>)// List<string>
let typeofDict1 = Types.loadGenericByAsm "mscorlib" "System.Collections.Generic.Dictionary" [typeof<string>; typeof<obj>]// Dictionary<string, object>
let typeofString2 = Types.loadByType "System.String"// sring
let typeofStringList2 = Types.loadGenericByType "System.Collections.Generic.List" (Seq.singleton typeof<string>)// List<string>
let typeofDict2 = Types.loadGenericByType "System.Collections.Generic.Dictionary" [typeof<string>; typeof<obj>]// Dictionary<string, object>

// constructor tests
let str1 = Constructors.call typeof<string> (Seq.singleton [|'a'; 'b'; 'c'|] |> getParamTypes)// "abc"
let date1 = Constructors.call typeof<DateTime> ([2013; 12; 25] |> getParamTypes)// 2013/12/25 0:00:00

// class for test
type Test()=
   static let clsField1 = "** clsField1 **"
   static let clsField2 = 200
   static let mutable _clsProp1inner = "** clsProp1 **"
   // fields
   let mutable _prop3inner = 0
   let mutable field1 = "** field1 **"
   let mutable field2 = "** field2 **"
   let mutable field3 = 3
   // methods
   member v.func0 () = sprintf "func0"
   member v.func1 x = sprintf "func1:%s" x
   member v.func1<'T> x = sprintf "func1<'T>:%s ('T:%s)" x typeof<'T>.Name
   member v.func2 (x, y) = sprintf "func2:%s %s" x y
   member v.func2<'T1, 'T2> (x, y) = sprintf "func2<'T1, 'T2>:%s %s ('T1:%s 'T2:%s)" x y typeof<'T1>.Name typeof<'T2>.Name
   //properties
   member v.prop1 with get() = "** prop1 **"
   member v.prop2 with get() = "** prop2 **"
   member v.prop3 with get() = _prop3inner and set(x) = _prop3inner<-x
   member val prop4  = "** prop4 **" with get,set
   static member clsProp1 with get() = _clsProp1inner and set(x) = _clsProp1inner <-x

let testObj = new Test()

// methods tests
let m0 = Methods.call typeof<Test> Bindings.instances testObj "func0" (Seq.empty |> getParamTypes)// "func0"
let m1 = Methods.call typeof<Test> Bindings.instances testObj "func1" (Seq.singleton "aaa" |> getParamTypes)// "func1:aaa"
let m2 = Methods.call typeof<Test> Bindings.instances testObj "func2" (["aaa"; "bbb"] |> getParamTypes)// "func2:aaa bbb"
let gm1 = Methods.callGeneric typeof<Test> Bindings.instances testObj "func1" [|typeof<int>|] (Seq.singleton "aaa" |> getParamTypes)// "func1<'T>:aaa ('T:Int32)"
let gm2 = Methods.callGeneric typeof<Test> Bindings.instances testObj "func2" [|typeof<int>; typeof<string>|] (["aaa"; "bbb"] |> getParamTypes)// "func2<'T1, 'T2>:aaa bbb ('T1:Int32 'T2:String)"

// properties tests
let p1 = Properties.get typeof<Test> Bindings.instances testObj "prop1"// "** prop1 **"
let p2 = Properties.get typeof<Test> Bindings.instances testObj "prop2"/// "** prop2 **"
let p3_1 = Properties.get typeof<Test> Bindings.instances testObj "prop3"// 0
Properties.set typeof<Test> Bindings.instances testObj "prop3" (box 30)
let p3_2 = Properties.get typeof<Test> Bindings.instances testObj "prop3"// 30
let p4_1 = Properties.get typeof<Test> Bindings.instances testObj "prop4"// "** prop4 **"
Properties.set typeof<Test> Bindings.instances testObj "prop4" (box "!! prop4 !!")
let p4_2 = Properties.get typeof<Test> Bindings.instances testObj "prop4"// "!! prop4 !!"

// fields tests
let f1 = Fields.get typeof<Test> Bindings.instances testObj "field1"// "** field1 **"
let f2 = Fields.get typeof<Test> Bindings.instances testObj "field2"// "** field2 **"
let f3_1 = Fields.get typeof<Test> Bindings.instances testObj "field3"// 3
Fields.set typeof<Test> Bindings.instances testObj "field3" (box 40)
let f3_2 = Fields.get typeof<Test> Bindings.instances testObj "field3"// 40

// static field tests
let cp1 = Properties.get typeof<Test> Bindings.statics null "clsProp1"// "** clsProp1 **"
let cf1inner = Fields.get typeof<Test> Bindings.statics null "_clsProp1inner"// "** clsProp1 **"
let cf1_1 = Fields.get typeof<Test> Bindings.statics null "clsField1" //NG
let cf1_2 = Properties.get typeof<Test> Bindings.statics null "clsField1" //NG
let cf2_1 = Fields.get typeof<Test> Bindings.statics null "clsField2" //NG
let cf2_2 = Properties.get typeof<Test> Bindings.statics null "clsField2" //NG


// expression versions tests
open Expressions

// constructor tests
let exstr = createConstructorEx<Func<char [], string>> (Constructors.getInfo typeof<string> Bindings.instances ([typeof<char []>] |> Seq.ofList))
let exstr_result = exstr.Invoke([|'a'; 'b'; 'c'|])// "abc"

let exdate = createConstructorEx<Func<int, int, int, DateTime>> (Constructors.getInfo typeof<DateTime> Bindings.instances ([typeof<int>;typeof<int>;typeof<int>] |> Seq.ofList))
let exdate_result = exdate.Invoke(2013, 12, 25)// 2013/12/25 0:00:00

let testObj2 = new Test()

// method
let exm0 = createCallingMethodEx<Func<Test, string>> (Methods.getInfo typeof<Test> Bindings.instances "func0" false List.empty)
let exm0_result = exm0.Invoke(testObj2)// "func0"

let exm1 = createCallingMethodEx<Func<Test, string, string>> (Methods.getInfo typeof<Test> Bindings.instances "func1" false [typeof<string>])
let exm1_result = exm1.Invoke(testObj2, "aaa")// "func1:aaa"

let exgm1 = createCallingMethodEx<Func<Test, string, string>> (Methods.getGenericInfo typeof<Test> Bindings.instances "func1" [|typeof<int>|] [typeof<string>])
let exgm1_result = exgm1.Invoke(testObj2, "aaa")// "func1<'T>:aaa ('T:Int32)"

// property
let exp3get = createGettingPropertyEx<Test, int> (Properties.getInfo typeof<Test> Bindings.instances "prop3")
let exp3get_result = exp3get.Invoke(testObj2)// 0

let exp3set = createSettingPropertyEx<Test, int> (Properties.getInfo typeof<Test> Bindings.instances "prop3")
let exp3set_result = exp3set.Invoke(testObj2, 50)
let exp3get2_result = exp3get.Invoke(testObj2) // 50

// field
let exf3get = createGettingFieldEx<Test, int> (Fields.getInfo typeof<Test> Bindings.instances "field3")
let exf3get_result = exf3get.Invoke(testObj2)// 3

let exf3set = createSettingFieldEx<Test, int> (Fields.getInfo typeof<Test> Bindings.instances "field3")
let exf3set_result = exf3set.Invoke(testObj2, 60)
let exf3get2_result = exf3get.Invoke(testObj2) // 60