Skip to content

Instantly share code, notes, and snippets.

@igeta

igeta/trait-in-fsharp.md

Last active October 6, 2015 17:28
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save igeta/3028691 to your computer and use it in GitHub Desktop.
Save igeta/3028691 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
trait-in-fsharp.md

F# コンパイラを改造して GenericMaxValue< ^T > を実装する

System.Int32.MaxValue と書きたくないのです。GenericMaxValue<int> と書きたいのです。

> let inline GenericMaxValue< ^T when ^T : (static member MaxValue : ^T) > : ^T =
-     (^T : (static member MaxValue : ^T) ())
- ;;

> type Foo(n : int) =
-     member x.Value = n
-     static member MaxValue = Foo(System.Int32.MaxValue)
- ;;

> GenericMaxValue<Foo>;;
val it : Foo = FSI_0003+Foo {Value = 2147483647;}
> GenericMaxValue<int>;;

  GenericMaxValue<int>;;
  ^^^^^^^^^^^^^^^

stdin(9,1): error FS0001: The type 'int' does not support any operators named 'get_MaxValue'

はい、ここからはじめまーす。

なお、本稿で使用する F# コンパイラ ソースコードは現行最新版の Aug2011.1 とします。

演算子オーバーロードとはなんだったのか

ところで話は変わりますが、F# における演算子はOCaml 的に見れば異常であり、.NET 的に見ればふつうであり、すなわち演算子オーバーロードが機能します。

2 + 3   // : int = 5
2. + 3. // : float = 5.0

C# に基づいて言うと、+ 演算子であれば、当該のクラスに operator+ を定義すればそのインスタンスに対して + 演算子を使用できるようになります。F# でもほぼ同様の手順で、任意の型に演算子をオーバーロード定義することができます。

type IntWrapper(n:int) =
    member this.Value = n
    static member (+) (x:IntWrapper, y:IntWrapper) =
        IntWrapper(x.Value + y.Value)

// IntWrapper 3 + IntWrapper 4 // = IntWrapper {Value = 7;}

そして F# では、演算子それ自体を定義することもできます。+ などの、オーバーロード可能な定義済みの演算子を任意の型に対してオーバーロード定義するのではなく、演算子自体を定義することができるのです。

let (+.) (x:float) (y:float) = x + y

// 3.4 +. 5.6 // = 9.0

で、もちろん、+ もどこかで定義された演算子であるわけです。各種型のオーバーロード定義を適切にさばいてくれるような定義であるわけです。この実物は、F# コンパイラのソースコード、prim-types.fs の3529行目に定義されています。以下に引用します。

let inline (+) (x: ^T) (y: ^U) : ^V = 
     AdditionDynamic<(^T),(^U),(^V)>  x y 
     when ^T : int32       and ^U : int32      = (# "add" x y : int32 #)
     when ^T : float       and ^U : float      = (# "add" x y : float #)
     when ^T : float32     and ^U : float32    = (# "add" x y : float32 #)
     when ^T : int64       and ^U : int64      = (# "add" x y : int64 #)
     when ^T : uint64      and ^U : uint64     = (# "add" x y : uint64 #)
     when ^T : uint32      and ^U : uint32     = (# "add" x y : uint32 #)
     when ^T : nativeint   and ^U : nativeint  = (# "add" x y : nativeint #)
     when ^T : unativeint  and ^U : unativeint = (# "add" x y : unativeint #)
     when ^T : int16       and ^U : int16      = (# "conv.i2" (# "add" x y : int32 #) : int16 #)
     when ^T : uint16      and ^U : uint16     = (# "conv.u2" (# "add" x y : uint32 #) : uint16 #)
     when ^T : char        and ^U : char       = (# "conv.u2" (# "add" x y : uint32 #) : char #)
     when ^T : sbyte       and ^U : sbyte      = (# "conv.i1" (# "add" x y : int32 #) : sbyte #)
     when ^T : byte        and ^U : byte       = (# "conv.u1" (# "add" x y : uint32 #) : byte #)
     when ^T : string      and ^U : string     = (# "" (System.String.Concat((# "" x : string #),(# "" y : string #))) : ^T #)
     when ^T : decimal     and ^U : decimal    = (# "" (System.Decimal.op_Addition((# "" x : decimal #),(# "" y : decimal #))) : ^V #)
     // According to the somewhat subtle rules of static optimizations,
     // this condition is used whenever ^T is resolved to a nominal type
     // That is, not in the generic implementation of '+'
     when ^T : ^T = ((^T or ^U): (static member (+) : ^T * ^U -> ^V) (x,y))

when という変なキーワードに気づきます。これは、値の型によるパターンマッチを静的に解決（コンパイル時に解決）するためのもので、コンパイラ内部でしか使用できない特殊な機能です。いやあ、力業です、プリミティブ型への特別対応、実に力業です。

F# コンパイラ内部の語彙においては、このような、それぞれの型によって振る舞いを変える機能を トレイト と呼び、また、特定の型にのみ適用可能とする制約を トレイト制約 と呼びます。

演算子以外のトレイト

いわゆる演算子以外にもトレイトが使われているものがあります。GenericZero< ^T > と GenericOne< ^T > です。

> open LanguagePrimitives;;
> GenericZero<int>;;
val it : int = 0
> GenericOne<int>;;
val it : int = 1
> GenericOne<float>;;
val it : int = 1.0
> GenericZero<char>;;

  GenericZero<char>;;
  ^^^^^^^^^^^

stdin(5,1): error FS0001: The type 'char' does not support any operators named 'get_Zero'

GenericZero および GenericOne は、Zero あるいは One という名前の static なプロパティが定義された型に対して使用可能な型関数であります。が、たとえば int 型には Zero やら One やらというプロパティは定義されてないわけでして、そもそもとしてプリミティブな型に対してはトレイトによる特別対応が必要なわけでして、まあ、あろうがなかろうが関係ないじゃんというわけです。そうなるようにトレイト制約を付ければよい、いやむしろ付けなければならないのですから。

して、これらの実装を調べます。どちらか一方で十分ですので、GenericOne の方を見ましょう。prim-types.fs の2278-2345行目、Microsoft.FSharp.Core.LanguagePrimitives モジュールに定義された以下の3つを見ておけばだいたいは把握できるでしょう。

  • GenericOneDynamicImplTable<'T>
  • GenericOneDynamic<'T>
  • GenericOne< ^T when ^T : (static member One : ^T) >

以下、ソースコードより引用。

[<CodeAnalysis.SuppressMessage("Microsoft.Performance","CA1812:AvoidUninstantiatedInternalClasses")>]
type GenericOneDynamicImplTable<'T>() = 
    static let result : 'T = 
        // The dynamic implementation
        let aty = typeof<'T>
        if   aty.Equals(typeof<sbyte>)      then unboxPrim<'T> (box 1y)
        elif aty.Equals(typeof<int16>)      then unboxPrim<'T> (box 1s)
        elif aty.Equals(typeof<int32>)      then unboxPrim<'T> (box 1)
        elif aty.Equals(typeof<int64>)      then unboxPrim<'T> (box 1L)
        elif aty.Equals(typeof<nativeint>)  then unboxPrim<'T> (box 1n)
        elif aty.Equals(typeof<byte>)       then unboxPrim<'T> (box 1uy)
        elif aty.Equals(typeof<uint16>)     then unboxPrim<'T> (box 1us)
        elif aty.Equals(typeof<char>)       then unboxPrim<'T> (box (retype 1us : char))
        elif aty.Equals(typeof<uint32>)     then unboxPrim<'T> (box 1u)
        elif aty.Equals(typeof<uint64>)     then unboxPrim<'T> (box 1UL)
        elif aty.Equals(typeof<unativeint>) then unboxPrim<'T> (box 1un)
        elif aty.Equals(typeof<decimal>)    then unboxPrim<'T> (box 1M)
        elif aty.Equals(typeof<float>)      then unboxPrim<'T> (box 1.0)
        elif aty.Equals(typeof<float32>)    then unboxPrim<'T> (box 1.0f)
        else 
           let pinfo = aty.GetProperty("One")
           unboxPrim<'T> (pinfo.GetValue(null,null))

    static member Result : 'T = result

let GenericOneDynamic< 'T >() : 'T = GenericOneDynamicImplTable<'T>.Result

let inline GenericOne< ^T when ^T : (static member One : ^T) > : ^T =
    GenericOneDynamic<(^T)>()
    when ^T : int32       = 1
    when ^T : float       = 1.0
    when ^T : float32     = 1.0f
    when ^T : int64       = 1L
    when ^T : uint64      = 1UL
    when ^T : uint32      = 1ul
    when ^T : nativeint   = 1n
    when ^T : unativeint  = 1un
    when ^T : int16       = 1s
    when ^T : uint16      = 1us
    when ^T : char        = (retype 1us : char)
    when ^T : sbyte       = 1y
    when ^T : byte        = 1uy
    when ^T : decimal     = 1M
     // According to the somewhat subtle rules of static optimizations,
     // this condition is used whenever ^T is resolved to a nominal type
     // That is, not in the generic implementation of '+'
    when ^T : ^T = (^T : (static member One : ^T) ())

わかったようなわからないようなですが、とりあえず、こんな風に定義されているようです。ここでは、これ以上の深堀はやめておきます。

コピペで作る GenericMaxValue< ^T >

そうです。目的は GenericMaxValue< ^T > ですよと。なんとなく、GenericOne< ^T > をベースにちょこちょこ書き換えればうまくいきそうです。というわけで、やってみます。標準ライブラリを改造、機能追加するのです。

あ、で、MaxValue があるんなら MinValue もなきゃねってことで、2つあわせて LanguagePrimitives に定義していきます。以下のコードを GenericOne< ^T > 周辺にうまいこと挿入していけばよいでしょう。

[<CodeAnalysis.SuppressMessage("Microsoft.Performance","CA1812:AvoidUninstantiatedInternalClasses")>]
type GenericMinValueDynamicImplTable<'T>() =
    static let result : 'T =
        // The dynamic implementation
        let aty = typeof<'T>
        if   aty.Equals(typeof<sbyte>)      then unboxPrim<'T> (box SByte.MinValue)
        elif aty.Equals(typeof<int16>)      then unboxPrim<'T> (box Int16.MinValue)
        elif aty.Equals(typeof<int32>)      then unboxPrim<'T> (box Int32.MinValue)
        elif aty.Equals(typeof<int64>)      then unboxPrim<'T> (box Int64.MinValue)
        elif aty.Equals(typeof<byte>)       then unboxPrim<'T> (box Byte.MinValue)
        elif aty.Equals(typeof<uint16>)     then unboxPrim<'T> (box UInt16.MinValue)
        elif aty.Equals(typeof<char>)       then unboxPrim<'T> (box Char.MinValue)
        elif aty.Equals(typeof<uint32>)     then unboxPrim<'T> (box UInt32.MinValue)
        elif aty.Equals(typeof<uint64>)     then unboxPrim<'T> (box UInt64.MinValue)
        elif aty.Equals(typeof<decimal>)    then unboxPrim<'T> (box Decimal.MinValue)
        elif aty.Equals(typeof<float>)      then unboxPrim<'T> (box Double.MinValue)
        elif aty.Equals(typeof<float32>)    then unboxPrim<'T> (box Single.MinValue)
        else
           let pinfo = aty.GetProperty("MinValue")
           unboxPrim<'T> (pinfo.GetValue(null,null))

    static member Result : 'T = result
    
[<CodeAnalysis.SuppressMessage("Microsoft.Performance","CA1812:AvoidUninstantiatedInternalClasses")>]
type GenericMaxValueDynamicImplTable<'T>() =
    static let result : 'T =
        // The dynamic implementation
        let aty = typeof<'T>
        if   aty.Equals(typeof<sbyte>)      then unboxPrim<'T> (box SByte.MaxValue)
        elif aty.Equals(typeof<int16>)      then unboxPrim<'T> (box Int16.MaxValue)
        elif aty.Equals(typeof<int32>)      then unboxPrim<'T> (box Int32.MaxValue)
        elif aty.Equals(typeof<int64>)      then unboxPrim<'T> (box Int64.MaxValue)
        elif aty.Equals(typeof<byte>)       then unboxPrim<'T> (box Byte.MaxValue)
        elif aty.Equals(typeof<uint16>)     then unboxPrim<'T> (box UInt16.MaxValue)
        elif aty.Equals(typeof<char>)       then unboxPrim<'T> (box Char.MaxValue)
        elif aty.Equals(typeof<uint32>)     then unboxPrim<'T> (box UInt32.MaxValue)
        elif aty.Equals(typeof<uint64>)     then unboxPrim<'T> (box UInt64.MaxValue)
        elif aty.Equals(typeof<decimal>)    then unboxPrim<'T> (box Decimal.MaxValue)
        elif aty.Equals(typeof<float>)      then unboxPrim<'T> (box Double.MaxValue)
        elif aty.Equals(typeof<float32>)    then unboxPrim<'T> (box Single.MaxValue)
        else
           let pinfo = aty.GetProperty("MaxValue")
           unboxPrim<'T> (pinfo.GetValue(null,null))

    static member Result : 'T = result

let GenericMinValueDynamic< 'T >() : 'T = GenericMinValueDynamicImplTable<'T>.Result
let GenericMaxValueDynamic< 'T >() : 'T = GenericMaxValueDynamicImplTable<'T>.Result

let inline GenericMinValue< ^T when ^T : (static member MinValue : ^T) > : ^T =
    GenericMinValueDynamic<(^T)>()
    when ^T : int32       = Int32.MinValue
    when ^T : float       = Single.MinValue
    when ^T : float32     = Double.MinValue
    when ^T : int64       = Int64.MinValue
    when ^T : uint64      = UInt64.MinValue
    when ^T : uint32      = UInt32.MinValue
    when ^T : int16       = Int16.MinValue
    when ^T : uint16      = UInt16.MinValue
    when ^T : char        = Char.MinValue
    when ^T : sbyte       = SByte.MinValue
    when ^T : byte        = Byte.MinValue
    when ^T : decimal     = Decimal.MinValue
    when ^T : ^T = (^T : (static member MinValue : ^T) ())

let inline GenericMaxValue< ^T when ^T : (static member MaxValue : ^T) > : ^T =
    GenericMaxValueDynamic<(^T)>()
    when ^T : int32       = Int32.MaxValue
    when ^T : float       = Single.MaxValue
    when ^T : float32     = Double.MaxValue
    when ^T : int64       = Int64.MaxValue
    when ^T : uint64      = UInt64.MaxValue
    when ^T : uint32      = UInt32.MaxValue
    when ^T : int16       = Int16.MaxValue
    when ^T : uint16      = UInt16.MaxValue
    when ^T : char        = Char.MaxValue
    when ^T : sbyte       = SByte.MaxValue
    when ^T : byte        = Byte.MaxValue
    when ^T : decimal     = Decimal.MaxValue
    when ^T : ^T = (^T : (static member MaxValue : ^T) ())

はい。fs ファイルを変更したら fsi も変更しなきゃです。これも GenericOne< ^T > 周辺に差し込んでいきます。

/// <summary>Resolves to the min value for any primitive numeric type or any type with a static member called 'MinValue'.</summary>
[<CompilerMessage("This function is for use by compiled F# code and should not be used directly", 1204, IsHidden=true)>]
val GenericMinValueDynamic : unit -> 'T

/// <summary>Resolves to the max value for any primitive numeric type or any type with a static member called 'MaxValue'.</summary>
[<CompilerMessage("This function is for use by compiled F# code and should not be used directly", 1204, IsHidden=true)>]
val GenericMaxValueDynamic : unit -> 'T

/// <summary>Resolves to the max value for any primitive numeric type or any type with a static member called 'MinValue'</summary>
val inline GenericMinValue< ^T > : ^T when ^T : (static member MinValue : ^T)

/// <summary>Resolves to the max value for any primitive numeric type or any type with a static member called 'MaxValue'</summary>
val inline GenericMaxValue< ^T > : ^T when ^T : (static member MaxValue : ^T)

うぉっしゃーと意気揚々コンパイル、したはいいものの、実はこれではまだ動かなかったりします。あいかわらず冒頭と同じエラーが出るばかりっていう。ちなみに、コンパイル方法はこの辺を参照。

言語組み込みのトレイト

やべー詰んだわーと思いつつ grep もとい findstr かけますと、csolve.fs にあやしい記述を見つけることができます。

で、これ、想像するにおそらくのところ、^T で示される静的に解決される型パラメーター（statically resolved type parameter）がトレイト制約によってプリミティブ型にも適用可能な場合、対象の型への適用時にエラーで弾かれないよう、制約解決器にも適切な記述が必要になる、ということかなと。自分で言っててよくわかりませんが。

つーわけで、ここからコンパイラ改造の領域に踏み込みます。

ともあれ csolve.fs の261-277行目を見ます。Microsoft.FSharp.Compiler.ConstraintSolver モジュールに定義された BakedInTraitConstraintNames をまず変更します。リストに "get_MinValue" と "get_MaxValue" を加えます。

let BakedInTraitConstraintNames = 
    [ "op_Division" ; "op_Multiply"; "op_Addition" 
      "op_Subtraction"; "op_Modulus"; 
      "get_Zero"; "get_One";
      "get_MinValue"; "get_MaxValue";
      "DivideByInt";"get_Item"; "set_Item";
      "op_BitwiseAnd"; "op_BitwiseOr"; "op_ExclusiveOr"; "op_LeftShift";
      "op_RightShift"; "op_UnaryPlus"; "op_UnaryNegation"; "get_Sign"; "op_LogicalNot"
      "op_OnesComplement"; "Abs"; "Sqrt"; "Sin"; "Cos"; "Tan";
      "Sinh";  "Cosh"; "Tanh"; "Atan"; "Acos"; "Asin"; "Exp"; "Ceiling"; "Floor"; "Round"; "Log10"; "Log"; "Sqrt";
      "Truncate"; "op_Explicit";
      "Pow"; "Atan2" ]

上記変更後の885行目、SolveMemberConstraint の定義内にある match minfos,tys,memFlags.IsInstance,nm,argtys with で始まる大きなパターン マッチに移動しまして、同パターン マッチ内に | [],[ty],false,"get_One",[] を見つけます。以下、その引用。

    | [],[ty],false,"get_One",[] 
        when IsNumericType g ty || isCharTy g ty ->
        SolveDimensionlessNumericType csenv ndeep m2 trace ty ++ (fun () -> 
        SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty ty ++ (fun () -> 
        ResultD TTraitBuiltIn))

イエス。ここで static member One すなわち get_One に対する制約解決が行われるわけですたぶんきっとおそらくはメイビープロバブリーパハップス。

そして毎度おなじみのコピペでやんすよ。コピペでパターンを継ぎ足すでやんすよ。nativeint に対しては使えなくてよいのでそこの判定だけ加えて。

    | [],[ty],false,"get_MinValue",[] 
        when IsNumericType g ty && not (isNativeIntegerTy g ty) || isCharTy g ty ->
        SolveDimensionlessNumericType csenv ndeep m2 trace ty ++ (fun () -> 
        SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty ty ++ (fun () -> 
        ResultD TTraitBuiltIn))

    | [],[ty],false,"get_MaxValue",[] 
        when IsNumericType g ty && not (isNativeIntegerTy g ty) || isCharTy g ty ->
        SolveDimensionlessNumericType csenv ndeep m2 trace ty ++ (fun () -> 
        SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty ty ++ (fun () -> 
        ResultD TTraitBuiltIn))

おｋ。ここまでやってからコンパイルすれば、今度こそ本当に動きます。

やりたかったこと

> open LanguagePrimitives;;
> let inline minv< ^T when ^T : (static member MinValue : ^T) > = GenericMinValue< ^T >;;
> let inline zero< ^T when ^T : (static member Zero : ^T) >     = GenericZero< ^T >;;
> let inline one<  ^T when ^T : (static member One : ^T) >      = GenericOne< ^T >;;
> let inline maxv< ^T when ^T : (static member MaxValue : ^T) > = GenericMaxValue< ^T >;;

> seq { one<int>..maxv<int> };;
val it : seq<int> = seq [1; 2; 3; 4; ...]
> seq { minv<byte>..maxv<byte> };;
val it : seq<byte> = seq [0uy; 1uy; 2uy; 3uy; ...]

うひょー。僕にも F# コンパイラ改造できたよー。

まとめ

trait キーワードのサポートまだー？

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment