/// <summary>
/// Instantiates a delegate that, given an IntPtr to a Haskell function, returns a
/// delegate instance (of the given delegate type) that wraps this native function
/// (and deals with parameter value marshaling and finalization).
/// </summary>
/// <param name="delegateType">Type of delegate returned by the returned delegate.</param>
/// <returns>
/// Wrapper delegate that accepts an IntPtr and returns a delegate of the
/// indicated type.
/// </returns>
public static IntPtr GenerateDelegateConstructorStub(Type delegateType)
{
// Obtain (creating, if necessary) the type of a wrapper class for the delegate
Type wrapperType = GetDelegateWrapperType(delegateType);
DelegateSignature delegateSignature = DelegateSignature.FromDelegateType(delegateType);
// Generate a dynamic method that does the following:
//
// Int32 [delegateType]New(IntPtr funPtr)
// {
// [wrapperType] wrapper = new [wrapperType](funPtr);
// Delegate d = new [delegateType](wrapper.Invoke);
// return Driver.RegisterObject(d);
// }
// Signature of the method returned (as a delegate) by this function (the
// method accepts an IntPtr to a Haskell function and returns an instantiated
// .NET delegate for it)
DelegateSignature methodSignature = new DelegateSignature(
typeof(Int32), new Type[] { typeof(IntPtr) });
return(GenerateDynamicMethod(delegateType.Name + "New", methodSignature,
delegate(ILGenerator ilg)
{
// wrapper = new [wrapperType](funPtr):
ilg.Emit(OpCodes.Ldarg_0);
ilg.Emit(OpCodes.Newobj, wrapperType.GetConstructor(new Type[] { typeof(IntPtr) }));
// Obtain wrapper.Invoke
ilg.Emit(OpCodes.Ldftn, wrapperType.GetMethod("Invoke"));
// Delegate d = new [delegateType](wrapper.Invoke):
ilg.Emit(OpCodes.Newobj, delegateType.GetConstructor(new Type[] { typeof(object), typeof(IntPtr) }));
// return Driver.RegisterObject(d):
ilg.Emit(OpCodes.Call, MemberInfos.Driver_RegisterObject);
ilg.Emit(OpCodes.Ret);
}));
}
/// <summary>
/// Creates (and returns the type of) a class that wraps a pointer to a
/// Haskell function as a .NET delegate. The class ensures that the
/// wrapper function pointer is freed when the delegate is no longer being
/// used by .NET. It also performs any translation from .NET values to
/// interop values (object references are converted to object identifiers).
/// </summary>
/// <param name="delegateType">Type of delegate produced by the wrapper</param>
private static Type CreateDelegateWrapperType(string name, Type delegateType)
{
// Obtain the signature of the delegate being produced
DelegateSignature delegateSignature = DelegateSignature.FromDelegateType(delegateType);
// Obtain the delegate type of the associated thunk for calling into Haskell
Type thunkDelegateType = new DelegateSignature(
ConvertToStubType(delegateSignature.ReturnType),
ConvertToStubTypes(delegateSignature.ParameterTypes)).ToDelegateType();
TypeBuilder typeBuilder = _dynamicModuleBuilder.DefineType(name,
TypeAttributes.Public | TypeAttributes.Sealed);
// Define the _thunkDelegate field
FieldBuilder thunkDelegateField = typeBuilder.DefineField("_thunkDelegate",
thunkDelegateType, FieldAttributes.Private);
{
// Define the constructor for the wrapper type:
//
// public DelegateWrapper(IntPtr funPtrToWrap)
// {
// _thunkDelegate = (ThunkDelegate)
// Marshal.GetDelegateForFunctionPointer(
// funPtrToWrap, typeof(ThunkDelegate));
// }
ConstructorBuilder constructorBuilder = typeBuilder.DefineConstructor(
MethodAttributes.Public | MethodAttributes.RTSpecialName,
CallingConventions.Standard, new Type[] { typeof(IntPtr) });
ILGenerator ilg = constructorBuilder.GetILGenerator();
// Call Object's constructor
ilg.Emit(OpCodes.Ldarg_0);
ilg.Emit(OpCodes.Call, MemberInfos.Object_ctor);
ilg.Emit(OpCodes.Ldarg_0); // Load this (for the 'stfld' below)
ilg.Emit(OpCodes.Ldarg_1); // Load funPtrToWrap
ilg.Emit(OpCodes.Ldtoken, thunkDelegateType); // Load typeof(ThunkDelegate)
ilg.Emit(OpCodes.Call, MemberInfos.Type_GetTypeFromHandle);
// Call (ThunkDelegate)Marshal.GetDelegateForFunctionPointer(
// funPtrToWrap, typeof(ThunkDelegate))
ilg.Emit(OpCodes.Call, MemberInfos.Marshal_GetDelegateForFunctionPointer);
ilg.Emit(OpCodes.Castclass, thunkDelegateType);
// Store in _thunkDelegate
ilg.Emit(OpCodes.Stfld, thunkDelegateField);
ilg.Emit(OpCodes.Ret);
}
{
// Define a Finalize method for the wrapper class:
//
// ~Delegate()
// {
// if (Driver.FreeHaskellFunPtr != null)
// Driver.FreeHaskellFunPtr(Marshal.GetFunctionPointerForDelegate(
// _thunkDelegate));
// }
MethodBuilder finalizeMethod = typeBuilder.DefineMethod("Finalize",
MethodAttributes.Family | MethodAttributes.HideBySig | MethodAttributes.Virtual);
finalizeMethod.SetImplementationFlags(MethodImplAttributes.IL | MethodImplAttributes.Managed);
ILGenerator ilg = finalizeMethod.GetILGenerator();
Label endLabel = ilg.DefineLabel();
// Obtain the freeHaskellFunPtr delegate
ilg.Emit(OpCodes.Ldsfld, MemberInfos.Driver_FreeHaskellFunPtr);
// Return immediately if the delegate is null
ilg.Emit(OpCodes.Ldc_I4_0);
ilg.Emit(OpCodes.Beq, endLabel);
// Obtain the freeHaskellFunPtr delegate (again)
ilg.Emit(OpCodes.Ldsfld, MemberInfos.Driver_FreeHaskellFunPtr);
// Load _thunkDelegate
ilg.Emit(OpCodes.Ldarg_0);
ilg.Emit(OpCodes.Ldfld, thunkDelegateField);
// Call Marshal.GetFunctionPointerForDelegate to obtain the original function pointerusing
ilg.Emit(OpCodes.Call, MemberInfos.Marshal_GetFunctionPointerForDelegate);
// Invoke freeHaskellFunPtr on this function pointer
ilg.Emit(OpCodes.Call, MemberInfos.FreeHaskellFunPtrDelegate_Invoke);
ilg.MarkLabel(endLabel);
ilg.Emit(OpCodes.Ret);
}
{
// Define an Invoke method that calls _thunkDelegate after marshaling
// the arguments as necessary:
//
// private void Invoke(...)
// {
// _thunkDelegate(... using RegisterObject as appropriate ...);
// }
MethodBuilder invokeMethod = typeBuilder.DefineMethod("Invoke",
MethodAttributes.Public, delegateSignature.ReturnType, delegateSignature.ParameterTypes);
ILGenerator ilg = invokeMethod.GetILGenerator();
// Load _thunkDelegate (for calling it later)
ilg.Emit(OpCodes.Ldarg_0);
ilg.Emit(OpCodes.Ldfld, thunkDelegateField);
// Load the parameters (and marshal according to type)
for (int i = 0; i < delegateSignature.ParameterTypes.Length; i++)
{
Util.EmitLdarg(ilg, i + 1);
EmitToStub(ilg, delegateSignature.ParameterTypes[i]);
}
ilg.Emit(OpCodes.Callvirt, thunkDelegateType.GetMethod("Invoke"));
EmitFromStub(ilg, delegateSignature.ReturnType);
ilg.Emit(OpCodes.Ret);
}
return(typeBuilder.CreateType());
}