ようこそ。睡眠不足なプログラマのチラ裏です。

型プロバイダー(TypeProviders)のちょっとしたアレコレ

一応、型プロバイダー(TypeProvider)のとりとめもない話 の続き。 ちょっと草植えときますね型言語Grass型プロバイダーを作った後、少し思い違いをしていた事に気付いたのが事の発端。この記事では、FsBulletML.TypeProvidersを作成する過程で得た、型プロバイダーについてのちょっとしたアレこれについて書いてみる。

オレは型プロバイダーに対する思い違いをしていた(雑魚)

  FsBulletMLという弾幕記述言語ライブラリを作っています。このライブラリでは、弾幕記述言語BulletML(XML形式等)を読み込んで弾幕を表現する判別共用体(内部DSL)の型を生成するということをやっています。構想の段階で BulletML(XML形式等) に判別共用体(内部DSL)の型を付ける型プロバイダーの提供も考えていたが、型プロバイダーでは判別共用体を作ることができないという理由から、このライブラリでの型プロバイダーの提供は一時保留としていた。


  で、
 

 


  大きな思い違いをしていたと気が付いた。型プロバイダーによってメタデータを元に"判別共用体の型そのものは作ることはできない"が、"型プロバイダーで作成した型が持つメソッドやプロパティを通じて、メタデータを元に作成した判別共用体を返すことはできる"ということに(気付くの遅すぎ)。
   

FsBulletMLで型プロバイダーを提供してみよう

ということで、FsBulletMLで型プロバイダーを提供してみることにした。

FsBulletMLで提供している3つの外部DSL(XML形式、SXML形式、FSB形式)をBulletml判別共用体(内部DSL)に型付けしてくれる型プロバイダーを提供したい。FsBulletMLでは、もともとFsBulletML.CoreFsBulletML.Parserという2つのパッケージをNuGetで提供している。これに加えて、FsBulletML.TypeProvidersというパッケージを新たに作成して提供したい。


FsBulletML.TypeProvidersを作成する過程で学んだことについて書いてみる。以下で現れる TypeProviderForNamespaces クラスは、FSharp.TypeProviders.StarterPack を利用している。


 

型プロバイダーに渡すことができる静的引数の種類

静的引数を扱う型プロバイダーについて、メタデータとしてもっとも渡されることの多い静的引数は string(文字列型) だろう。実際、文字列さえ渡すことができればだいたいなんでもできる。ただ、他にどのような型を渡すことができるのかについても把握しておきたい。


基本的には、プリミティブ型 (F#)を静的引数として渡すことができる。ただし、nativeint, unativeint, System.Void, unit など CLI定数リテラルとしてコンパイルできないものは型プロバイダーの静的引数として渡すことができない。また、enum(列挙型) も基になる型は (sbyte、byte、int16、uint16、int32、uint32、int64、uint64、char) のいずれかであるため、静的引数として渡すことができる。


 

open System
open Sample.Domain

type Test = StaticParametersSample<true,86uy,86y,86s,86us,86,86u,86L,86UL,'a',"a",0.7833M,86.0F,86.,ColorSbyte.Red,ColorByte.Green,ColorInt16.Blue,ColorUint16.Red, ColorInt32.Green, ColorUint32.Blue, ColorInt64.Red, ColorUint64.Green, ColorChar.Blue>

[<EntryPoint>]
let main argv = 
  let test = new Test()
  test.Value |> printfn "%A"

  Console.ReadKey () |> ignore
  0


  実行結果

(true, 86uy, 86y, 86s, 86us, 86, 86u, 86L, 86UL, 'a', "a", 0.7833M, 86.0f, 86.0,
 Red, Green, Blue, Red, Green, Blue, Red, Green, Blue)

 

namespace Sample.Domain

open System
open System.IO
open System.Reflection
open System.Linq
open Microsoft.FSharp.Core.CompilerServices
open ProviderImplementation.ProvidedTypes

type ColorSbyte =
   | Red = 0y
   | Green = 1y
   | Blue = 2y

type ColorByte =
   | Red = 0uy
   | Green = 1uy
   | Blue = 2uy

type ColorInt16 =
   | Red = 0s
   | Green = 1s
   | Blue = 2s

type ColorUint16 =
   | Red = 0us
   | Green = 1us
   | Blue = 2us

type ColorInt32 =
   | Red = 0
   | Green = 1
   | Blue = 2

type ColorUint32 =
   | Red = 0u
   | Green = 1u
   | Blue = 2u

type ColorInt64 =
   | Red = 0L
   | Green = 1L
   | Blue = 2L

type ColorUint64 =
   | Red = 0UL
   | Green = 1UL
   | Blue = 2UL

type ColorChar =
   | Red = 'a'
   | Green = 'b'
   | Blue = 'c'

[<AutoOpen>]
module EnumExtentions = 
  let enum<'a,'b when 'b : enum<'a>> x = Microsoft.FSharp.Core.LanguagePrimitives.EnumOfValue<'a, 'b >(x)

[<TypeProvider>] 
type public StaticParametersSampleTypeProvider () as this = 
  inherit TypeProviderForNamespaces ()
  let asm = Assembly.GetExecutingAssembly()
  let ns = "Sample.Domain"

  let typ = ProvidedTypeDefinition(asm, ns, "StaticParametersSample", Some (typeof<obj>), HideObjectMethods = true, IsErased = true)
  do
    let parameters = 
      [ProvidedStaticParameter("bool", typeof<bool>)
       ProvidedStaticParameter("byte", typeof<byte>)
       ProvidedStaticParameter("sbyte", typeof<sbyte>)
       ProvidedStaticParameter("int16", typeof<int16>)
       ProvidedStaticParameter("uint16", typeof<uint16>)
       ProvidedStaticParameter("int", typeof<int>)
       ProvidedStaticParameter("uint32", typeof<uint32>)
       ProvidedStaticParameter("int64", typeof<int64>)
       ProvidedStaticParameter("uint64", typeof<uint64>)
       ProvidedStaticParameter("char", typeof<char>)
       ProvidedStaticParameter("string", typeof<string>)
       ProvidedStaticParameter("decimal", typeof<decimal>)
       ProvidedStaticParameter("float32", typeof<float32>)
       ProvidedStaticParameter("float", typeof<float>)
       ProvidedStaticParameter("ColorSbyte", typeof<ColorSbyte>)
       ProvidedStaticParameter("ColorByte", typeof<ColorByte>)
       ProvidedStaticParameter("ColorInt16", typeof<ColorInt16>)
       ProvidedStaticParameter("ColorUint16", typeof<ColorUint16>)
       ProvidedStaticParameter("ColorInt32", typeof<ColorInt32>)
       ProvidedStaticParameter("ColorUint32", typeof<ColorUint32>)
       ProvidedStaticParameter("ColorInt64", typeof<ColorInt64>)
       ProvidedStaticParameter("ColorUint64", typeof<ColorUint64>)
       ProvidedStaticParameter("ColorChar", typeof<ColorChar>)]

    typ.DefineStaticParameters(
        parameters,
        fun typeName parameters ->
          match parameters with
          | [| :?bool as pBool
               :?byte as pByte
               :?sbyte as pSbyte
               :?int16 as pInt16
               :?uint16 as pUint16
               :?int as pInt32
               :?uint32 as pUint32
               :?int64 as pInt64
               :?uint64 as pUint64
               :?char as pChar
               :?string as pString
               :?decimal as pDecimal
               :?float32 as pSingle
               :?float as pDouble
               :?sbyte as pColorSbyte
               :?byte as pColorByte
               :?int16 as pColorInt16
               :?uint16 as pColorUint16
               :?int as pColorInt32
               :?uint32 as pColorUint32
               :?int64 as pColorInt64
               :?uint64 as pColorUint64
               :?char as pColorChar
             |] -> 
            let typ = ProvidedTypeDefinition(asm, ns, typeName, Some typeof<obj>, HideObjectMethods = true, IsErased = true)
            let ctor = ProvidedConstructor(parameters = [ ], InvokeCode= (fun _ -> <@@ () @@>))
            typ.AddMember ctor
            typ.AddMemberDelayed(fun () ->
              let value = 
                <@@ pBool,
                    pByte, 
                    pSbyte, 
                    pInt16, 
                    pUint16, 
                    pInt32, 
                    pUint32, 
                    pInt64, 
                    pUint64, 
                    pChar, 
                    pString, 
                    pDecimal, 
                    pSingle, 
                    pDouble, 
                    enum<sbyte, ColorSbyte> pColorSbyte, 
                    enum<byte, ColorByte> pColorByte,
                    enum<int16, ColorInt16> pColorInt16, 
                    enum<uint16, ColorUint16> pColorUint16, 
                    enum<int, ColorInt32> pColorInt32,
                    enum<uint32, ColorUint32> pColorUint32, 
                    enum<int64, ColorInt64> pColorInt64, 
                    enum<uint64, ColorUint64> pColorUint64, 
                    enum<char, ColorChar> pColorChar 
                    @@>
              let instanceProp = 
                ProvidedProperty
                  (propertyName = "Value", 
                   propertyType = 
                     typeof<bool * 
                            byte * 
                            sbyte * 
                            int16 *
                            uint16 *
                            int *
                            uint32 *
                            int64 *
                            uint64 *
                            char *
                            string *
                            decimal *
                            float32 *
                            float * 
                            ColorSbyte *
                            ColorByte *
                            ColorInt16 *
                            ColorUint16 *
                            ColorInt32 *
                            ColorUint32 *
                            ColorInt64 *
                            ColorUint64 *
                            ColorChar
                            >, 
                                 GetterCode= (fun _ -> value))
              instanceProp.AddXmlDocDelayed(fun () -> 
                sprintf "<summary><para>%A</para></summary>" <|
                   (pBool, 
                    pByte, 
                    pSbyte, 
                    pInt16, 
                    pUint16, 
                    pInt32, 
                    pUint32, 
                    pInt64, 
                    pUint64, 
                    pChar, 
                    pString, 
                    pDecimal, 
                    pSingle, 
                    pDouble, 
                    enum<sbyte, ColorSbyte> pColorSbyte, 
                    enum<byte, ColorByte> pColorByte,
                    enum<int16, ColorInt16> pColorInt16, 
                    enum<uint16, ColorUint16> pColorUint16, 
                    enum<int, ColorInt32> pColorInt32,
                    enum<uint32, ColorUint32> pColorUint32, 
                    enum<int64, ColorInt64> pColorInt64, 
                    enum<uint64, ColorUint64> pColorUint64, 
                    enum<char, ColorChar> pColorChar ))
              instanceProp)
            typ
          | _ -> failwith "Invalid parameter" )

    this.AddNamespace(ns, [typ])

[<assembly:TypeProviderAssembly>] 
do()

 

へぇ。とくに面白くはない。


型プロバイダーの実行部分は部分的な制限がある

型プロバイダーでは、メソッドやプロパティの実装をコードクォートによって行うため部分的な制限がある。

たとえば、

namespace Sample.Domain

open System
open System.IO
open System.Linq
open System.Reflection
open Microsoft.FSharp.Core.CompilerServices
open ProviderImplementation.ProvidedTypes

type Hoge =
  | Fuga of string
  | Piyo of int

[<TypeProvider>] 
type public Sample1ErasedTypeProvider(cfg:TypeProviderConfig) as this = 
  inherit TypeProviderForNamespaces()
  let asm = Assembly.GetExecutingAssembly()
  let ns = "Sample.Domain"
  let parameters = [ProvidedStaticParameter("source", typeof<string>)]

  let typ = ProvidedTypeDefinition(asm, ns, "Sample1", Some (typeof<obj>), HideObjectMethods = true, IsErased = true)
  do
    typ.DefineStaticParameters(
        parameters,
        fun typeName parameters ->
          let source = string parameters.[0]
          let typ = ProvidedTypeDefinition(asm, ns, typeName, Some typeof<obj>, HideObjectMethods = true, IsErased = true)
          let ctor = ProvidedConstructor(parameters = [ ], InvokeCode= (fun _ -> <@@ source @@>))
          typ.AddMember ctor
          let p,r = Int32.TryParse(source)
          typ.AddMemberDelayed(fun () ->
            let value = p |> function | true -> Hoge.Piyo r | _ -> Hoge.Fuga source
            let instanceProp = 
              ProvidedProperty(propertyName = "Value", 
                               propertyType = typeof<Hoge>, 
                               GetterCode= (fun _ -> <@@ value @@>))
            instanceProp.AddXmlDocDelayed(fun () -> sprintf "<summary><para>%A</para></summary>" value)
            instanceProp)
          typ)
    this.AddNamespace(ns, [typ])

[<assembly:TypeProviderAssembly>] 
do()

Valueプロパティの値を、XMLドキュメントでも参照できるようにしている。上記のコードは、コンパイルが通るので一見良さそうにみえるが、コードクォート内から value に束縛した値をうまく参照することができないため、以下のようなエラーとなる

f:id:zecl:20140825175254p:plain


なんてことはない。直接コードクォート内に記述するとうまくいく。

namespace Sample.Domain

open System
open System.IO
open System.Linq
open System.Reflection
open Microsoft.FSharp.Core.CompilerServices
open ProviderImplementation.ProvidedTypes

[<TypeProvider>] 
type public Sample2ErasedTypeProvider(cfg:TypeProviderConfig) as this = 
  inherit TypeProviderForNamespaces()
  let asm = Assembly.GetExecutingAssembly()
  let ns = "Sample.Domain"
  let parameters = [ProvidedStaticParameter("source", typeof<string>)]

  let typ = ProvidedTypeDefinition(asm, ns, "Sample2", Some (typeof<obj>), HideObjectMethods = true, IsErased = true)
  do
    typ.DefineStaticParameters(
        parameters,
        fun typeName parameters ->
          let source = string parameters.[0]
          let typ = ProvidedTypeDefinition(asm, ns, typeName, Some typeof<obj>, HideObjectMethods = true, IsErased = true)
          let ctor = ProvidedConstructor(parameters = [ ], InvokeCode= (fun _ -> <@@ source @@>))
          typ.AddMember ctor
          let p,r = Int32.TryParse(source)
          typ.AddMemberDelayed(fun () ->
            let value = p |> function | true -> Hoge.Piyo r | _ -> Hoge.Fuga source
            let instanceProp = 
              ProvidedProperty(propertyName = "Value", 
                               propertyType = typeof<Hoge>, 
                               GetterCode= (fun _ -> <@@ p |> function | true -> Hoge.Piyo r | _ -> Hoge.Fuga source @@>))
            instanceProp.AddXmlDocDelayed(fun () -> sprintf "<summary><para>%A</para></summary>" value)
            instanceProp)
          typ)
    this.AddNamespace(ns, [typ])

[<assembly:TypeProviderAssembly>] 
do()

ただこれだとコードが重複してしまって気持ちが悪い。


ひとつは、以下のようにFSharp.PowerPackを用いてコードの重複を避けるという方法も考えられるが、Linq.QuotationEvaluationは万能とはいいがたいし、 FSharp.PowerPackに依存するのも何か違う感じがするのでこれは避けたい。

namespace Sample.Domain

open System
open System.IO
open System.Linq
open System.Reflection
open Microsoft.FSharp.Core.CompilerServices
open ProviderImplementation.ProvidedTypes
open Linq.QuotationEvaluation

[<TypeProvider>] 
type public Sample3ErasedTypeProvider(cfg:TypeProviderConfig) as this = 
  inherit TypeProviderForNamespaces()
  let asm = Assembly.GetExecutingAssembly()
  let ns = "Sample.Domain"
  let parameters = [ProvidedStaticParameter("source", typeof<string>)]

  let typ = ProvidedTypeDefinition(asm, ns, "Sample3", Some (typeof<obj>), HideObjectMethods = true, IsErased = true)
  do
    typ.DefineStaticParameters(
        parameters,
        fun typeName parameters ->
          let source = string parameters.[0]
          let typ = ProvidedTypeDefinition(asm, ns, typeName, Some typeof<obj>, HideObjectMethods = true, IsErased = true)
          let ctor = ProvidedConstructor(parameters = [ ], InvokeCode= (fun _ -> <@@ source @@>))
          typ.AddMember ctor
          let p,r = Int32.TryParse(source)
          typ.AddMemberDelayed(fun () ->
            let value = <@@ p |> function | true -> Hoge.Piyo r | _ -> Hoge.Fuga source @@>
            let instanceProp = 
              ProvidedProperty(propertyName = "Value", 
                               propertyType = typeof<Hoge>, 
                               GetterCode= (fun _ -> value))
            instanceProp.AddXmlDocDelayed(fun () -> sprintf "<summary><para>%A</para></summary>" (value.EvalUntyped()))
            instanceProp)
          typ)
    this.AddNamespace(ns, [typ])

[<assembly:TypeProviderAssembly>] 
do()

 

通常は、module に関数を外出しすることでこれを回避する。

namespace Sample.Domain

open System
open System.IO
open System.Linq
open System.Reflection
open Microsoft.FSharp.Core.CompilerServices
open ProviderImplementation.ProvidedTypes

module internal Hogehoge =
  let f source = 
    let p,r = Int32.TryParse(source)
    p |> function | true -> Hoge.Piyo r | _ -> Hoge.Fuga source

[<TypeProvider>] 
type public Sample4ErasedTypeProvider(cfg:TypeProviderConfig) as this = 
  inherit TypeProviderForNamespaces()
  let asm = Assembly.GetExecutingAssembly()
  let ns = "Sample.Domain"
  let parameters = [ProvidedStaticParameter("source", typeof<string>)]

  let typ = ProvidedTypeDefinition(asm, ns, "Sample4", Some (typeof<obj>), HideObjectMethods = true, IsErased = true)
  do
    typ.DefineStaticParameters(
        parameters,
        fun typeName parameters ->
          let source = string parameters.[0]
          let typ = ProvidedTypeDefinition(asm, ns, typeName, Some typeof<obj>, HideObjectMethods = true, IsErased = true)
          let ctor = ProvidedConstructor(parameters = [ ], InvokeCode= (fun _ -> <@@ source @@>))
          typ.AddMember ctor
          typ.AddMemberDelayed(fun () ->
            let instanceProp = 
              ProvidedProperty(propertyName = "Value", 
                               propertyType = typeof<Hoge>, 
                               GetterCode= (fun _ -> <@@ Hogehoge.f source @@>))
            instanceProp.AddXmlDocDelayed(fun () -> sprintf "<summary><para>%A</para></summary>" (Hogehoge.f source))
            instanceProp)
          typ)
    this.AddNamespace(ns, [typ])

[<assembly:TypeProviderAssembly>] 
do()

  これはコンパイルも通るし Sample4 型プロバイダーを利用する側のコードもコンパイルが通るので良さそうに見える。  

f:id:zecl:20140825180549p:plain


  しかし、実行すると次の例外が発生する。当然と言えば当然だが型プロバイダーの実行時に public ではない module を参照することはできないからである。  

f:id:zecl:20140825180421p:plain

 

かといって、 Hogehoge module を単に public にするだけだと、見せたくないものがそのまま垂れ流しで見えてしまうので、どうも具合がわるい。そこで、CompilerMessage属性を利用するという苦肉の策を使う。

[<CompilerMessage("hidden...", 13730, IsError = false, IsHidden = true)>]
module Hogehoge =
  let f source = 
    let p,r = Int32.TryParse(source)
    p |> function | true -> Hoge.Piyo r | _ -> Hoge.Fuga source

 
ところで、EditorBrowsable氏~ 人気ないの~?ないの~?
F# IntelliSense doesn't respect the EditorBrowsable attribute


他のDLLに依存する型プロバイダーを作る

FsBulletMLで型プロバイダーを提供するにあたって、実装はFsBulletML.CoreおよびFsBulletML.Parserに依存するようにしたい。 FsBulletML.Coreは、XML形式のBulletMLをパースする機能を持っている。FsBulletML.Parserは、SXML形式とFSB形式をパースする機能を持っている。 それぞれのDLLを参照してしまえば、ちょっと草植えておきますね型言語Grass型プロバイダーと同じようなノリで簡単に実装できるはずだ。そう考えた。 実際、実装そのものは容易にできた。しかし実行するとうまくいかない。単に依存対象のDLLを参照しただけではだめなのだ。型プロバイダーのコンパイルは通るが、利用時にエラーとなる。型プロバイダーのコンパイル時に参照できている DLL が実行時には参照できないことが原因だ。


  たとえば、次のコードの DLL を参照した型プロバイダーを作る。

namespace Library1
open System

type Hoge =
  | Fuga of string
  | Piyo of int

module Fugafuga =
  let f source = 
    let p,r = Int32.TryParse(source)
    p |> function | true -> Hoge.Piyo r | _ -> Hoge.Fuga source


型プロバイダー

namespace Sample.Domain

open System
open System.IO
open System.Linq
open System.Reflection
open Microsoft.FSharp.Core.CompilerServices
open ProviderImplementation.ProvidedTypes
open Library1

[<TypeProvider>] 
type public Sample5ErasedTypeProvider(cfg:TypeProviderConfig) as this = 
  inherit TypeProviderForNamespaces()
  let asm = Assembly.GetExecutingAssembly()
  let ns = "Sample.Domain"
  let parameters = [ProvidedStaticParameter("source", typeof<string>)]

  let typ = ProvidedTypeDefinition(asm, ns, "Sample5", Some (typeof<obj>), HideObjectMethods = true, IsErased = true)
  do
    typ.DefineStaticParameters(
        parameters,
        fun typeName parameters ->
          let source = string parameters.[0]
          let typ = ProvidedTypeDefinition(asm, ns, typeName, Some typeof<obj>, HideObjectMethods = true, IsErased = true)
          let ctor = ProvidedConstructor(parameters = [ ], InvokeCode= (fun _ -> <@@ source @@>))
          typ.AddMember ctor
          typ.AddMemberDelayed(fun () ->
            let instanceProp = 
              ProvidedProperty(propertyName = "Value", 
                               propertyType = typeof<Hoge>, 
                               GetterCode= (fun _ -> <@@ Fugafuga.f source @@>))
            instanceProp.AddXmlDocDelayed(fun () -> sprintf "<summary><para>%A</para></summary>" (Fugafuga.f source))
            instanceProp)
          typ)
    this.AddNamespace(ns, [typ])

[<assembly:TypeProviderAssembly>] 
do()

コンパイルが通るし一見良さそうに見えるが、この型プロバイダーを利用しようとすると以下のようになる。

f:id:zecl:20140825181323p:plain

型プロバイダーのコンパイル時に参照できている DLL が型プロバイダーの実行時に参照できていないためにこのようなエラーとなる。 Library1.dll が存在するパスを、型プロバイダーの探索対象にあらかじめ登録しておく必要がある。 TypeProviderForNamespaces クラスのRegisterProbingFolderメソッドでこれを解決できる。

namespace Sample.Domain

open System
open System.IO
open System.Linq
open System.Reflection
open Microsoft.FSharp.Core.CompilerServices
open ProviderImplementation.ProvidedTypes
open Library1

[<TypeProvider>] 
type public Sample5ErasedTypeProvider(cfg:TypeProviderConfig) as this = 
  inherit TypeProviderForNamespaces()
  let asm = Assembly.GetExecutingAssembly()
  let ns = "Sample.Domain"
  let parameters = [ProvidedStaticParameter("source", typeof<string>)]

  let typ = ProvidedTypeDefinition(asm, ns, "Sample5", Some (typeof<obj>), HideObjectMethods = true, IsErased = true)
  do
    typ.DefineStaticParameters(
        parameters,
        fun typeName parameters ->
          let source = string parameters.[0]
          let typ = ProvidedTypeDefinition(asm, ns, typeName, Some typeof<obj>, HideObjectMethods = true, IsErased = true)
          let ctor = ProvidedConstructor(parameters = [ ], InvokeCode= (fun _ -> <@@ source @@>))
          typ.AddMember ctor
          typ.AddMemberDelayed(fun () ->
            let instanceProp = 
              ProvidedProperty(propertyName = "Value", 
                               propertyType = typeof<Hoge>, 
                               GetterCode= (fun _ -> <@@ Fugafuga.f source @@>))
            instanceProp.AddXmlDocDelayed(fun () -> sprintf "<summary><para>%A</para></summary>" (Fugafuga.f source))
            instanceProp)
          typ)
    this.AddNamespace(ns, [typ])

    let thisAssembly = Assembly.GetAssembly(typeof<Sample5ErasedTypeProvider>)
    let path = Path.GetDirectoryName(thisAssembly.Location)
    this.RegisterProbingFolder path

[<assembly:TypeProviderAssembly>] 
do()

このように実装することで、型プロバイダーと同じパスに存在するDLLが実行時に参照可能となる。


他のNuGetパッケージに依存した型プロバイダーを作ってNuGetで配布するときのやり方

FsBulletML.TypeProvidersは、FsBulletML.CoreおよびFsBulletML.ParserのNuGetパッケージに依存するかたちで配布したい。この場合、他のNuGetパッケージが展開されるフォルダのパスを考慮した実装が必要となる。もっとも良さそうな方法は、package.configのXMLを読み込んで参照するパスを解決する方法が考えられる。 FsBulletML.TypeProvidersでは、下記のような感じで、型プロバイダーが依存するNuGetパッケージのパスを探索するよう実装することでこれを解決した。

  let registerDependencies config registerProbingFolder =
    let thisAssembly = Assembly.GetAssembly(typeof<Style>)
    let path = Path.GetDirectoryName(thisAssembly.Location)
    registerProbingFolder path
      
    let packagePath p = Helper.getUpDirectory 3 path + p
    let currentPath p = path + p
#if NET40
    let tf = "net40"
#endif
#if NET45
    let tf = "net45"
#endif
    let packageConfig = 
      Helper.findConfigFile (config:TypeProviderConfig).ResolutionFolder "packages.config"
    let packageInfo = 
      if File.Exists(packageConfig) then
        use xmlReader = XmlReader.Create(packageConfig)
        let doc = XDocument.Load(xmlReader)
        let (!) x = XName.op_Implicit x
        query {
          for packages in doc.Elements(!"packages") do
          for package in packages.Elements(!"package") do
          select (package.Attribute(!"id").Value, package.Attribute(!"version").Value,package.Attribute(!"targetFramework").Value) } 
      else Seq.empty 

    let getInfo name defaultVersion =  
        match packageInfo |> Seq.tryFind(fun (x,_,_) -> x = name) with
        | Some (_,v,tf) -> v, tf
        | None -> defaultVersion, tf

    let dependencies =
      let core =
        let name = "FsBulletML.Core"
        let version, targetFramework = getInfo name "0.9.0"
        [sprintf @"\%s.%s\lib\%s" name version targetFramework]
      let fparsec = 
        let name = "FParsec"
        let version, _ = getInfo name "1.0.1"
        [sprintf @"\%s.%s\lib\net40-client" name version]
      let parser = 
        let name = "FsBulletML.Parser"
        let version, targetFramework = getInfo name "0.8.6"
        [sprintf @"\%s.%s\lib\%s" name version targetFramework]
      core @ fparsec @ parser

    let packages = 
      dependencies 
      |> Seq.map packagePath
      |> Seq.append (dependencies |> Seq.map currentPath)
      |> Seq.filter (fun x -> Directory.Exists x)
    packages |> Seq.iter registerProbingFolder

ということで、FsBulletML.TypeProvidersリリースしました。

f:id:zecl:20140825181636p:plain


型プロバイダーが参照するファイルの更新チェックを実装する

型プロバイダーが想定するスキーマが変更された場合、F# 言語サービスがそのプロバイダーを無効化するようにシグナルを通知することができる。シグナルが通知されると、型プロバイダーがVisual Studio上でホストされている場合に限り、再度型チェックが行われる。 これを利用して型プロバイダーが参照するファイルの更新チェックを実装することができる。具体的には、FileSystemWatcherクラス等でファイルの状態を監視し、適切なタイミングで CompilerServices.ITypeProvider インターフェイス (F#)のInvalidateメソッドを呼び出すように実装すればよい。FsBulletML.TypeProvidersでも実装しています。


ソースはここにあります。 FsBulletML/src/FsBulletML.TypeProviders at master · zecl/FsBulletML · GitHub


消去型と生成型

最後に、@bleisさんのTypeProviderについて、勝手に補足で紹介されていた生成型の型プロバイダーのひじょーにシンプルな例についてご紹介。


まず、消去型のサンプル

namespace Sample.Domain

open System
open System.IO
open System.Linq
open System.Reflection
open Microsoft.FSharp.Core.CompilerServices
open ProviderImplementation.ProvidedTypes

type Hoge =
  | Fuga of string
  | Piyo of int

[<CompilerMessage("hidden...", 13730, IsError = false, IsHidden = true)>]
module Sample = 
  let f source =
    let p,r = Int32.TryParse(source)
    p |> function | true -> Hoge.Piyo r | _ -> Hoge.Fuga source

#nowarn "13730"
[<TypeProvider>] 
type public SampleErasedTypeProvider(cfg:TypeProviderConfig) as this = 
  inherit TypeProviderForNamespaces()
  let asm = Assembly.GetExecutingAssembly()
  let ns = "Sample.Domain"
  let parameters = [ProvidedStaticParameter("source", typeof<string>)]

  let typ = ProvidedTypeDefinition(asm, ns, "Erased", Some (typeof<obj>), HideObjectMethods = true, IsErased = true)
  do
    typ.DefineStaticParameters(
        parameters,
        fun typeName parameters ->
          let source = string parameters.[0]
          let typ = ProvidedTypeDefinition(asm, ns, typeName, Some typeof<obj>, HideObjectMethods = true, IsErased = true)
          let ctor = ProvidedConstructor(parameters = [ ], InvokeCode= (fun _ -> <@@ source @@>))
          typ.AddMember ctor
          typ.AddMemberDelayed(fun () ->
            let instanceProp = 
              ProvidedProperty(propertyName = "Value", 
                               propertyType = typeof<Hoge>, 
                               GetterCode= (fun _ -> <@@ Sample.f source @@>))
            instanceProp.AddXmlDocDelayed(fun () -> sprintf "<summary><para>%A</para></summary>" (Sample.f source))
            instanceProp)
          typ)
    this.AddNamespace(ns, [typ])

[<assembly:TypeProviderAssembly>] 
do()


型が消えてますね。

f:id:zecl:20140825181814p:plain


f:id:zecl:20140825190217p:plain


ILDASMで逆コンパイルした結果も見てみましょう。 はい。型が消去されています。

.method public static int32  main(string[] argv) cil managed
{
  .entrypoint
  .custom instance void [FSharp.Core]Microsoft.FSharp.Core.EntryPointAttribute::.ctor() = ( 01 00 00 00 ) 
  // コード サイズ       71 (0x47)
  .maxstack  4
  .locals init ([0] object hoge,
           [1] class [TypeProviderGenType]Sample.Domain.Hoge V_1,
           [2] object V_2,
           [3] class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class [TypeProviderGenType]Sample.Domain.Hoge,class [FSharp.Core]Microsoft.FSharp.Core.Unit> V_3,
           [4] class [TypeProviderGenType]Sample.Domain.Hoge V_4,
           [5] valuetype [mscorlib]System.ConsoleKeyInfo V_5,
           [6] valuetype [mscorlib]System.ConsoleKeyInfo V_6)
  IL_0000:  nop
  IL_0001:  ldstr      "123"
  IL_0006:  box        [mscorlib]System.String
  IL_000b:  unbox.any  [mscorlib]System.Object
  IL_0010:  stloc.0
  IL_0011:  ldloc.0
  IL_0012:  stloc.2
  IL_0013:  ldstr      "123"
  IL_0018:  call       class [TypeProviderGenType]Sample.Domain.Hoge [TypeProviderGenType]Sample.Domain.Sample::f(string)
  IL_001d:  stloc.1
  IL_001e:  ldstr      "%A"
  IL_0023:  newobj     instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class [TypeProviderGenType]Sample.Domain.Hoge,class [FSharp.Core]Microsoft.FSharp.Core.Unit>,class [mscorlib]System.IO.TextWriter,class [FSharp.Core]Microsoft.FSharp.Core.Unit,class [FSharp.Core]Microsoft.FSharp.Core.Unit,class [TypeProviderGenType]Sample.Domain.Hoge>::.ctor(string)
  IL_0028:  call       !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatLine<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class [TypeProviderGenType]Sample.Domain.Hoge,class [FSharp.Core]Microsoft.FSharp.Core.Unit>>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4<!!0,class [mscorlib]System.IO.TextWriter,class [FSharp.Core]Microsoft.FSharp.Core.Unit,class [FSharp.Core]Microsoft.FSharp.Core.Unit>)
  IL_002d:  stloc.3
  IL_002e:  ldloc.1
  IL_002f:  stloc.s    V_4
  IL_0031:  ldloc.3
  IL_0032:  ldloc.s    V_4
  IL_0034:  callvirt   instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class [TypeProviderGenType]Sample.Domain.Hoge,class [FSharp.Core]Microsoft.FSharp.Core.Unit>::Invoke(!0)
  IL_0039:  pop
  IL_003a:  call       valuetype [mscorlib]System.ConsoleKeyInfo [mscorlib]System.Console::ReadKey()
  IL_003f:  stloc.s    V_5
  IL_0041:  ldloc.s    V_5
  IL_0043:  stloc.s    V_6
  IL_0045:  ldc.i4.0
  IL_0046:  ret
} // end of method Program::main


これを生成型の型プロバイダーに書き直してみます。

namespace Sample.Domain

open System
open System.IO
open System.Linq
open System.Reflection
open Microsoft.FSharp.Core.CompilerServices
open ProviderImplementation.ProvidedTypes

type Piyo () = 
  member this.Printfn (v) = printfn "%A" v

#nowarn "13730"
[<TypeProvider>] 
type public SampleNotErasedTypeProvider(cfg:TypeProviderConfig) as this = 
  inherit TypeProviderForNamespaces()
  let asm = Assembly.GetExecutingAssembly()
  let ns = "Sample.Domain"

  let tempAsm = ProvidedAssembly (Path.ChangeExtension (Path.GetTempFileName (), ".dll"))
  do
    let typ = ProvidedTypeDefinition(asm, ns, "NotErased", Some (typeof<obj>), IsErased = false)
    tempAsm.AddTypes [typ]
    let parameters = [ProvidedStaticParameter("source", typeof<string>)]
    typ.DefineStaticParameters (parameters, this.GenerateTypes)
    this.AddNamespace(ns, [typ])

  member internal this.GenerateTypes (typeName: string) (args: obj[]) =
    let source = string args.[0]
    let typ = ProvidedTypeDefinition (asm, ns, typeName, Some typeof<Piyo>, IsErased = false)
    let ctor = ProvidedConstructor(parameters = [ ], InvokeCode= (fun _ -> <@@ source @@>))
    typ.AddMember ctor
    typ.AddMemberDelayed(fun () ->
      let instanceProp = 
        ProvidedProperty(propertyName = "Value", 
                         propertyType = typeof<Hoge>, 
                         GetterCode= (fun _ -> <@@ Sample.f source @@>))
      instanceProp.AddXmlDocDelayed(fun () -> sprintf "<summary><para>%A</para></summary>" (Sample.f source))
      instanceProp)
    tempAsm.AddTypes [typ]
    typ

[<assembly:TypeProviderAssembly>] 
do()

ポイントは、ProvidedTypeDefinitionIsErased = falseとすること。 ProvidedAssemblyで一時アセンブリを作り、そのアセンブリAddTypesで生成する型を登録することです。 この例では、アセンブリ内に定義したPiyoクラスを継承する型を生成しています。

f:id:zecl:20140825181847p:plain


f:id:zecl:20140825181909p:plain


ILDASMで逆コンパイルした結果を見てみましょう。

.method public static int32  main(string[] argv) cil managed
{
  .entrypoint
  .custom instance void [FSharp.Core]Microsoft.FSharp.Core.EntryPointAttribute::.ctor() = ( 01 00 00 00 ) 
  // コード サイズ       53 (0x35)
  .maxstack  4
  .locals init ([0] class Program/HogeA hoge,
           [1] class [TypeProviderGenType]Sample.Domain.Hoge V_1,
           [2] class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class [TypeProviderGenType]Sample.Domain.Hoge,class [FSharp.Core]Microsoft.FSharp.Core.Unit> V_2,
           [3] class [TypeProviderGenType]Sample.Domain.Hoge V_3,
           [4] valuetype [mscorlib]System.ConsoleKeyInfo V_4,
           [5] valuetype [mscorlib]System.ConsoleKeyInfo V_5)
  IL_0000:  nop
  IL_0001:  newobj     instance void Program/HogeA::.ctor()
  IL_0006:  stloc.0
  IL_0007:  ldloc.0
  IL_0008:  callvirt   instance class [TypeProviderGenType]Sample.Domain.Hoge Program/HogeA::get_Value()
  IL_000d:  stloc.1
  IL_000e:  ldstr      "%A"
  IL_0013:  newobj     instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class [TypeProviderGenType]Sample.Domain.Hoge,class [FSharp.Core]Microsoft.FSharp.Core.Unit>,class [mscorlib]System.IO.TextWriter,class [FSharp.Core]Microsoft.FSharp.Core.Unit,class [FSharp.Core]Microsoft.FSharp.Core.Unit,class [TypeProviderGenType]Sample.Domain.Hoge>::.ctor(string)
  IL_0018:  call       !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatLine<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class [TypeProviderGenType]Sample.Domain.Hoge,class [FSharp.Core]Microsoft.FSharp.Core.Unit>>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4<!!0,class [mscorlib]System.IO.TextWriter,class [FSharp.Core]Microsoft.FSharp.Core.Unit,class [FSharp.Core]Microsoft.FSharp.Core.Unit>)
  IL_001d:  stloc.2
  IL_001e:  ldloc.1
  IL_001f:  stloc.3
  IL_0020:  ldloc.2
  IL_0021:  ldloc.3
  IL_0022:  callvirt   instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class [TypeProviderGenType]Sample.Domain.Hoge,class [FSharp.Core]Microsoft.FSharp.Core.Unit>::Invoke(!0)
  IL_0027:  pop
  IL_0028:  call       valuetype [mscorlib]System.ConsoleKeyInfo [mscorlib]System.Console::ReadKey()
  IL_002d:  stloc.s    V_4
  IL_002f:  ldloc.s    V_4
  IL_0031:  stloc.s    V_5
  IL_0033:  ldc.i4.0
  IL_0034:  ret
} // end of method Program::main


Visual Studio上でも確認ができたように、型が消去されずに、Piyoクラスを継承したHogeAクラスが型プロバイダーによって生成されていることが確認できます。




うほ!とても面白いアイデア。 生成型の型プロバイダーだと確かにそういった構想の面白いブツが作れそうですね(wktk)。

ということで、型プロバイダー(Type Provider)のちょっとしたアレコレを書いてみました。それはそうと、Visual F# Power Toolsなのか他の拡張機能なのかわからないけど、型プロバイダーを書いたりデバッグしていると、割と頻繁になにかしらの拡張機能のエラーのダイアログがでてきてウザいですよ(激おこ)。