4 people like it.

Codomains through Reflection

Any type signature has the form of a curried chain T0 -> T1 -> .... -> Tn, where Tn is not a function type. The codomain of a type is precisely Tn. This is a simple implementation that uses reflection to determine the codomain for arbitrary types.

 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: 
open System
open Microsoft.FSharp.Core.OptimizedClosures

// for 'T = 'T0 -> 'T1 -> ... -> 'Tn, returns the type of 'Tn
let codomain<'T> : 'T -> Type =
    let fsFunctionTypes =
        [
            typedefof<FSharpFunc<_,_>>
            typedefof<FSharpFunc<_,_,_>>
            typedefof<FSharpFunc<_,_,_,_>>
            typedefof<FSharpFunc<_,_,_,_,_>>
            typedefof<FSharpFunc<_,_,_,_,_,_>>
        ] 
        |> Seq.map (fun t -> t.GUID)
        |> Set.ofSeq

    let (|FSharpFunc|_|) (t : Type) =
        let isFSharpFunc (t: Type) =
            t <> null && t.IsGenericType && 
                t.GetGenericTypeDefinition().GUID |> fsFunctionTypes.Contains

        match isFSharpFunc t, isFSharpFunc t.BaseType with
        | true, _ -> Some t
        | _, true -> Some t.BaseType
        | _ -> None

    let rec traverse =
        function
        | FSharpFunc func ->
            let funcTypes = func.GetGenericArguments()
            let returningType = funcTypes.[funcTypes.Length - 1]
            traverse returningType
        | other -> other

    fun f -> f.GetType() |> traverse

// examples:
codomain 2
codomain <| fun x y z w -> (x + y + Int32.Parse(z) + w).ToString()
codomain codomain
namespace System
namespace Microsoft
namespace Microsoft.FSharp
namespace Microsoft.FSharp.Core
module OptimizedClosures

from Microsoft.FSharp.Core
val codomain<'T> : ('T -> Type)

Full name: Script.codomain
type Type =
  inherit MemberInfo
  member Assembly : Assembly
  member AssemblyQualifiedName : string
  member Attributes : TypeAttributes
  member BaseType : Type
  member ContainsGenericParameters : bool
  member DeclaringMethod : MethodBase
  member DeclaringType : Type
  member Equals : o:obj -> bool + 1 overload
  member FindInterfaces : filter:TypeFilter * filterCriteria:obj -> Type[]
  member FindMembers : memberType:MemberTypes * bindingAttr:BindingFlags * filter:MemberFilter * filterCriteria:obj -> MemberInfo[]
  ...

Full name: System.Type
val fsFunctionTypes : Set<Guid>
val typedefof<'T> : Type

Full name: Microsoft.FSharp.Core.Operators.typedefof
Multiple items
type FSharpFunc<'T1,'T2,'U> =
  inherit FSharpFunc<'T1,('T2 -> 'U)>
  new : unit -> FSharpFunc<'T1,'T2,'U>
  abstract member Invoke : arg1:'T1 * arg2:'T2 -> 'U
  static member Adapt : func:('T1 -> 'T2 -> 'U) -> FSharpFunc<'T1,'T2,'U>

Full name: Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc<_,_,_>

--------------------
type FSharpFunc<'T1,'T2,'T3,'U> =
  inherit FSharpFunc<'T1,('T2 -> 'T3 -> 'U)>
  new : unit -> FSharpFunc<'T1,'T2,'T3,'U>
  abstract member Invoke : arg1:'T1 * arg2:'T2 * arg3:'T3 -> 'U
  static member Adapt : func:('T1 -> 'T2 -> 'T3 -> 'U) -> FSharpFunc<'T1,'T2,'T3,'U>

Full name: Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc<_,_,_,_>

--------------------
type FSharpFunc<'T1,'T2,'T3,'T4,'U> =
  inherit FSharpFunc<'T1,('T2 -> 'T3 -> 'T4 -> 'U)>
  new : unit -> FSharpFunc<'T1,'T2,'T3,'T4,'U>
  abstract member Invoke : arg1:'T1 * arg2:'T2 * arg3:'T3 * arg4:'T4 -> 'U
  static member Adapt : func:('T1 -> 'T2 -> 'T3 -> 'T4 -> 'U) -> FSharpFunc<'T1,'T2,'T3,'T4,'U>

Full name: Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc<_,_,_,_,_>

--------------------
type FSharpFunc<'T1,'T2,'T3,'T4,'T5,'U> =
  inherit FSharpFunc<'T1,('T2 -> 'T3 -> 'T4 -> 'T5 -> 'U)>
  new : unit -> FSharpFunc<'T1,'T2,'T3,'T4,'T5,'U>
  abstract member Invoke : arg1:'T1 * arg2:'T2 * arg3:'T3 * arg4:'T4 * arg5:'T5 -> 'U
  static member Adapt : func:('T1 -> 'T2 -> 'T3 -> 'T4 -> 'T5 -> 'U) -> FSharpFunc<'T1,'T2,'T3,'T4,'T5,'U>

Full name: Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc<_,_,_,_,_,_>

--------------------
new : unit -> FSharpFunc<'T,'U>

--------------------
new : unit -> FSharpFunc<'T1,'T2,'U>

--------------------
new : unit -> FSharpFunc<'T1,'T2,'T3,'U>

--------------------
new : unit -> FSharpFunc<'T1,'T2,'T3,'T4,'U>

--------------------
new : unit -> FSharpFunc<'T1,'T2,'T3,'T4,'T5,'U>
module Seq

from Microsoft.FSharp.Collections
val map : mapping:('T -> 'U) -> source:seq<'T> -> seq<'U>

Full name: Microsoft.FSharp.Collections.Seq.map
val t : Type
property Type.GUID: Guid
Multiple items
module Set

from Microsoft.FSharp.Collections

--------------------
type Set<'T (requires comparison)> =
  interface IComparable
  interface IEnumerable
  interface IEnumerable<'T>
  interface ICollection<'T>
  new : elements:seq<'T> -> Set<'T>
  member Add : value:'T -> Set<'T>
  member Contains : value:'T -> bool
  override Equals : obj -> bool
  member IsProperSubsetOf : otherSet:Set<'T> -> bool
  member IsProperSupersetOf : otherSet:Set<'T> -> bool
  ...

Full name: Microsoft.FSharp.Collections.Set<_>

--------------------
new : elements:seq<'T> -> Set<'T>
val ofSeq : elements:seq<'T> -> Set<'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Set.ofSeq
val isFSharpFunc : (Type -> bool)
property Type.IsGenericType: bool
Type.GetGenericTypeDefinition() : Type
member Set.Contains : value:'T -> bool
property Type.BaseType: Type
union case Option.Some: Value: 'T -> Option<'T>
union case Option.None: Option<'T>
val traverse : (Type -> Type)
Multiple items
active recognizer FSharpFunc: Type -> Type option

--------------------
type FSharpFunc<'T1,'T2,'U> =
  inherit FSharpFunc<'T1,('T2 -> 'U)>
  new : unit -> FSharpFunc<'T1,'T2,'U>
  abstract member Invoke : arg1:'T1 * arg2:'T2 -> 'U
  static member Adapt : func:('T1 -> 'T2 -> 'U) -> FSharpFunc<'T1,'T2,'U>

Full name: Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc<_,_,_>

--------------------
type FSharpFunc<'T1,'T2,'T3,'U> =
  inherit FSharpFunc<'T1,('T2 -> 'T3 -> 'U)>
  new : unit -> FSharpFunc<'T1,'T2,'T3,'U>
  abstract member Invoke : arg1:'T1 * arg2:'T2 * arg3:'T3 -> 'U
  static member Adapt : func:('T1 -> 'T2 -> 'T3 -> 'U) -> FSharpFunc<'T1,'T2,'T3,'U>

Full name: Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc<_,_,_,_>

--------------------
type FSharpFunc<'T1,'T2,'T3,'T4,'U> =
  inherit FSharpFunc<'T1,('T2 -> 'T3 -> 'T4 -> 'U)>
  new : unit -> FSharpFunc<'T1,'T2,'T3,'T4,'U>
  abstract member Invoke : arg1:'T1 * arg2:'T2 * arg3:'T3 * arg4:'T4 -> 'U
  static member Adapt : func:('T1 -> 'T2 -> 'T3 -> 'T4 -> 'U) -> FSharpFunc<'T1,'T2,'T3,'T4,'U>

Full name: Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc<_,_,_,_,_>

--------------------
type FSharpFunc<'T1,'T2,'T3,'T4,'T5,'U> =
  inherit FSharpFunc<'T1,('T2 -> 'T3 -> 'T4 -> 'T5 -> 'U)>
  new : unit -> FSharpFunc<'T1,'T2,'T3,'T4,'T5,'U>
  abstract member Invoke : arg1:'T1 * arg2:'T2 * arg3:'T3 * arg4:'T4 * arg5:'T5 -> 'U
  static member Adapt : func:('T1 -> 'T2 -> 'T3 -> 'T4 -> 'T5 -> 'U) -> FSharpFunc<'T1,'T2,'T3,'T4,'T5,'U>

Full name: Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc<_,_,_,_,_,_>

--------------------
new : unit -> FSharpFunc<'T,'U>

--------------------
new : unit -> FSharpFunc<'T1,'T2,'U>

--------------------
new : unit -> FSharpFunc<'T1,'T2,'T3,'U>

--------------------
new : unit -> FSharpFunc<'T1,'T2,'T3,'T4,'U>

--------------------
new : unit -> FSharpFunc<'T1,'T2,'T3,'T4,'T5,'U>
val func : Type
val funcTypes : Type []
Type.GetGenericArguments() : Type []
val returningType : Type
property Array.Length: int
val other : Type
val f : 'T
Object.GetType() : Type
val x : int
val y : int
val z : string
val w : int
type Int32 =
  struct
    member CompareTo : value:obj -> int + 1 overload
    member Equals : obj:obj -> bool + 1 overload
    member GetHashCode : unit -> int
    member GetTypeCode : unit -> TypeCode
    member ToString : unit -> string + 3 overloads
    static val MaxValue : int
    static val MinValue : int
    static member Parse : s:string -> int + 3 overloads
    static member TryParse : s:string * result:int -> bool + 1 overload
  end

Full name: System.Int32
Int32.Parse(s: string) : int
Int32.Parse(s: string, provider: IFormatProvider) : int
Int32.Parse(s: string, style: Globalization.NumberStyles) : int
Int32.Parse(s: string, style: Globalization.NumberStyles, provider: IFormatProvider) : int

More information

Link:http://fssnip.net/cf
Posted:11 years ago
Author:Eirik Tsarpalis
Tags: codomain , reflection , fsharpfunc