Dynamic Interface Implementation for C# in F#

gistfile1.fs

/*
   // Example usage:
   var inst = _Implement.Interface<ISomeInterface>(new
         {
            AMethod = new Func<String, Int32>(s => Int32.Parse(s)),
            Foobar = new
            {
               get = "foobar",
               set = new Action<String>(s => {})
            }
         });
*/

namespace Aquabrowser.Core.Reflection

module _Implement =

   open System
   open System.Reflection
   open System.Reflection.Emit
   open Aquabrowser.Core
   open EmitUtils
   open System.ComponentModel

   type MethodOrProp =
         | Method of MethodInfo
         | PropertyGet of PropertyInfo
         | PropertySet of PropertyInfo
         member this.ActualMethod =
            match this with
               | Method m -> m
               | PropertyGet p -> p.GetGetMethod()
               | PropertySet p -> p.GetSetMethod()
         member this.Name =
            match this with
               | Method m -> m.Name
               | PropertyGet p -> p.Name 
               | PropertySet p -> p.Name

   let private haveInterface (t: Type) (i: Type) =
      t.GetInterfaces() |> Array.exists (fun _i -> _i = i)

   let private implCount = ref 0L

   let Interface (o: obj): 'TInterface =
      let interfaceType = typeof<'TInterface>
     
      if (not interfaceType.IsInterface) then 
         raise (new MLException("Interface type '{0}' is not an interface.", interfaceType.FullName))

      // Generates a unique name for each implementation..
      let id = System.Threading.Interlocked.Increment(implCount)

      let name = interfaceType.Namespace + "." + interfaceType.Name.Replace('`', ' ');
      let asmName = new AssemblyName("_Dynamicinterface_Implementation_For_" + name);
      let asmBuilder = AppDomain.CurrentDomain.DefineDynamicAssembly(asmName, AssemblyBuilderAccess.RunAndCollect);
      let modBuilder = asmBuilder.DefineDynamicModule("_Dynamicinterface_Implementation_Module_For_" + interfaceType.FullName);
      let typBuilder = modBuilder.DefineType(interfaceType.Name + "@DynamicInterfaceImplementation" + id.ToString("X"), TypeAttributes.Class ||| TypeAttributes.Public);
      typBuilder.AddInterfaceImplementation(interfaceType)

      let rec getProps (_type: Type) : PropertyInfo seq =
         seq {
               for t in Seq.append (Seq.singleton(_type)) (_type.GetInterfaces()) do
                  yield! t.GetProperties()
         }

      let rec getMethods (_type: Type) : MethodInfo seq =
         seq {
               for t in Seq.append (Seq.singleton(_type)) (_type.GetInterfaces()) do
                  for m in t.GetMethods() do
                     // Assume that special name methods are getters/setters.
                     // If this is not rigorous enough, could simply check there is no property with this method backing it.
                     if (int(m.Attributes &&& System.Reflection.MethodAttributes.SpecialName) = 0) then
                        yield m
         }

      let interfaceMethodsAndProps = 
         Seq.toArray (seq {
            yield! Seq.cast<MemberInfo> (getProps interfaceType)
            yield! Seq.cast<MemberInfo> (getMethods interfaceType)
         })

      let memberCount = interfaceMethodsAndProps.Length
      let anonymousBindingFlags = BindingFlags.NonPublic ||| BindingFlags.Public ||| BindingFlags.Instance
   
      let getPropValues (prop: PropertyInfo) (anon: obj) = seq {
         if (prop.PropertyType.IsArray) then
            // If the property is an array: overload resolution.
            yield! (prop.GetValue(anon) :?> obj[])
         else
            yield prop.GetValue(anon)
         }

      // Tests whether return type and parameter count and types of both methods match exactly.
      let methodsMatch (m1: MethodInfo) (m2: MethodInfo) =
         if m1.ReturnType <> m2.ReturnType then false
         else
            let m1Params = m1.GetParameters()
            let m2Params = m2.GetParameters()
            if m1Params.Length <> m2Params.Length then false
            else
               Array.forall (fun (a: ParameterInfo, b: ParameterInfo) -> a.ParameterType = b.ParameterType) (Array.zip m1Params m2Params)

      let rec findMethodImpl (m: MethodOrProp) (name: String) (anon: obj) (goDeeper: bool) =
         seq {
            for prop in anon.GetType().GetProperties(anonymousBindingFlags) do
               if String.CompareOrdinal(prop.Name, name) = 0 then
                  for v in (getPropValues prop anon) do
                     if (v :? System.Delegate) then
                        let invokeMethod = v.GetType().GetMethod("Invoke")
                        if (methodsMatch m.ActualMethod invokeMethod) then
                           yield (v, prop.PropertyType)
                     else if (m.ActualMethod.GetParameters().Length = 0 && m.ActualMethod.ReturnType = prop.PropertyType) then
                        // A method or property getter without arguments can be implemented by a value.
                        yield (v, prop.PropertyType)
                     else if goDeeper then
                        match m with
                        | PropertyGet _ -> yield! findMethodImpl m "get" v false
                        | PropertySet _ -> yield! findMethodImpl m "set" v false
                        | _ -> failwith "Invalid Operation"
         }

      let findMethodImpl (m: MethodOrProp) = 
         let impls = Seq.toArray(findMethodImpl m m.Name o (match m with Method _ -> false | _ -> true))
         let typestr = match m with Method _ -> "method" | _ -> "property"
         if impls.Length = 1 then impls.[0]
         else if impls.Length = 0 then failwithf "No implementation found for %s %s." typestr m.Name
         else failwithf "Multiple implementations (%d) found for %s %s." (impls.Length) typestr m.Name

      let getMethodsOrProperties (m: MemberInfo) = seq {
         if m :? MethodInfo then 
            yield Method(m :?> MethodInfo)
         else
            let p = m :?> PropertyInfo
            if p.GetGetMethod() <> null then
               yield PropertyGet(p)
            if p.GetSetMethod() <> null then
               yield PropertySet(p)
      }

      // For each method that we implement, define a field that holds our delegate.
      let methodsOrProps = [| for i = 0 to (memberCount - 1) do yield! (getMethodsOrProperties (interfaceMethodsAndProps.[i])) |]
      let delegateMembers = Array.zeroCreate<obj> methodsOrProps.Length

      for i = 0 to methodsOrProps.Length - 1 do
         let methodOrProp = methodsOrProps.[i]

         let m = methodOrProp.ActualMethod

         // Get whatever we'll use to implement the method
         let (v, propType) = findMethodImpl methodOrProp

         delegateMembers.[i] <- v

         let paramTypes = Seq.toArray(seq {
               for p in m.GetParameters() do
                  yield p.ParameterType
               })
         let methodAtts = (m.Attributes ||| MethodAttributes.Final) &&& ~~~MethodAttributes.Abstract

         // Implement the method.
         let methodBldr = typBuilder.DefineMethod(m.Name, methodAtts, m.ReturnType, paramTypes)
         let asm = new EmitBuilder(methodBldr.GetILGenerator())

         if v :? System.Delegate then
            // Invoke the delegate.
            let delegateBldr = typBuilder.DefineField("_delegate" + i.ToString(), typeof<System.Delegate>, FieldAttributes.Private)

            asm {
               yield OpCodes.Ldarg_0
               yield OpCodes.Ldfld, (delegateBldr :> FieldInfo) // Load delegate
            }
            for j = 0 to (m.GetParameters().Length - 1) do 
               asm {
                  yield OpCodes.Ldarg, (j + 1)    
               }

            asm {
               yield OpCodes.Callvirt, delegateMembers.[i].GetType().GetMethod("Invoke") // (match delegateMembers.[i] with (_, invokeMethod) -> invokeMethod)
               yield OpCodes.Ret
            }
         else 
            // Return the field, note we cant use v.GetType() as v could be null!
            let valueFld = typBuilder.DefineField("_value" + i.ToString(), propType, FieldAttributes.Private)
            asm {
               yield OpCodes.Ldarg_0
               yield OpCodes.Ldfld, (valueFld :> FieldInfo)
               yield OpCodes.Ret
            }

         // And ensure to implement the actual interface method.
         typBuilder.DefineMethodOverride(methodBldr, m)

      // Finally, create the actual proxy type.
      let finalType = typBuilder.CreateType()

      let instance = (Activator.CreateInstance(finalType)) :?> 'TInterface

      // Set the delegates or values in our private fields.
      for i = 0 to (methodsOrProps.Length - 1) do
         let fld = finalType.GetField("_delegate" + i.ToString(), BindingFlags.Instance ||| BindingFlags.NonPublic)
         if (fld <> null) then fld.SetValue(instance, delegateMembers.[i])
         else
            let fld = finalType.GetField("_value" + i.ToString(), BindingFlags.Instance ||| BindingFlags.NonPublic)
            fld.SetValue(instance, delegateMembers.[i])

      // Return and we're done.
      instance