//
// Salsa .NET Driver
//
// Licence:   BSD3 (see LICENSE)
//

using System;
using System.Linq;
using System.Collections.Generic;
using System.Text;
using System.Runtime.InteropServices;
using System.Net;
using System.Reflection;
using System.Reflection.Emit;
using System.Diagnostics;
using System.IO;
using System.Threading;

[assembly: AssemblyTitle("Salsa")]
[assembly: AssemblyDescription(".NET Bridge for Haskell")]
[assembly: AssemblyProduct("Salsa")]
[assembly: AssemblyCopyright("Copyright © 2007-2008 Andrew Appleyard")]
[assembly: AssemblyVersion("1.0.0.0")]
[assembly: AssemblyFileVersion("1.0.0.0")]

// TODO: Consider caching the results of the Get*Stub(string, ...) methods
//       (although it's not really necessary, Haskell will cache the results).

namespace Salsa
{
    public class Driver
    {
        internal static AssemblyBuilder _assemblyBuilder;
        internal static ModuleBuilder _dynamicModuleBuilder;
        internal static TypeBuilder _stubsTypeBuilder;

        static Driver()
        {
            //Console.WriteLine("Using Salsa.dll (version {0})",
            //    Assembly.GetExecutingAssembly().GetName().Version);

            Trace.Listeners.Add(new ConsoleTraceListener());

            _assemblyBuilder = AppDomain.CurrentDomain.DefineDynamicAssembly(
                new AssemblyName("DynamicAssembly"), AssemblyBuilderAccess.RunAndSave);
            _dynamicModuleBuilder = _assemblyBuilder.DefineDynamicModule("DynamicModule", "Dynamic.dll");
            _stubsTypeBuilder = _dynamicModuleBuilder.DefineType("Stubs");

            _inTable.Add(_nextId++, true);  // ObjectId 1
            _inTable.Add(_nextId++, false); // ObjectId 2
        }

        public static IntPtr Boot()
        {
            // TODO: Accept an option from Salsa for the threading model to use
            // Thread.CurrentThread.SetApartmentState(ApartmentState.STA);

            return GetPointerToMethod("GetPointerToMethod");
        }

        /// <summary>
        /// Returns a native function pointer (as an int) to a stub wrapping the given method.
        /// </summary>
        /// <remarks>
        /// This is the first .NET function called by Haskell, and is called by using the
        /// ICLRRuntimeHost.ExecuteInDefaultAppDomain method.
        /// </remarks>
        public static IntPtr GetPointerToMethod(string methodName)
        {
            //Trace.WriteLine("GetPointerToMethod(" + methodName + ")");
            //Console.WriteLine("Called on thread: " + System.Threading.Thread.CurrentThread.ManagedThreadId);

            MethodInfo meth = typeof(Driver).GetMethod(methodName);
            if (meth == null)
                throw new ArgumentException("Method not found.", methodName);

            // Return a delegate pointing to the indicated method (cast to an int
            // so we can call this method using ExecuteInDefaultAppDomain)
            return GenerateMethodStub(meth);
        }

        #region Entry points

        /// <summary>
        /// This method is called by Haskell so that the .NET side of the bridge
        /// has access to the Haskell function 'freeHaskellFunPtr'.
        /// </summary>
        public static void SetFreeHaskellFunPtr(IntPtr freeHaskellFunPtr)
        {
            if (freeHaskellFunPtr == IntPtr.Zero)
            {
                // Clear any previously stored delegate wrapping 'freeHaskellFunPtr'
                // (this will prevent calls into Haskell from .NET finalizers)
                FreeHaskellFunPtr = null;
            }
            else
            {
                // Store the delegate wrapping the 'freeHaskellFunPtr' function passed in
                FreeHaskellFunPtr =
                    (FreeHaskellFunPtrDelegate)Marshal.GetDelegateForFunctionPointer(
                        freeHaskellFunPtr, typeof(FreeHaskellFunPtrDelegate));
            }
            Trace.WriteLine(string.Format("SetFreeHaskellFunPtr(0x{0:x})", freeHaskellFunPtr));
        }

        public static FreeHaskellFunPtrDelegate FreeHaskellFunPtr;

        /// <summary>
        /// Saves the assembly containing the dynamically generated wrapper methods and
        /// delegate classes created during the bridge operation.
        /// </summary>
        public static void SaveDynamicAssembly()
        {
            _stubsTypeBuilder.CreateType();

            string fileName = Path.GetFileName(_dynamicModuleBuilder.FullyQualifiedName);
            Console.WriteLine("Saving dynamic assembly: " + fileName);
            _assemblyBuilder.Save(fileName);
        }

        /// <summary>
        /// Given the class, name, and signature of a method or constructor, returns a
        /// native function pointer to a delegate that calls the method or constructor
        /// when invoked.
        /// </summary>
        /// <remarks>
        /// Use a 'methodName' of '.ctor' to obtain a constructor stub.
        /// </remarks>
        public static IntPtr GetMethodStub(string className, string methodName,
            string parameterTypeNames)
        {
            if (methodName == ".ctor")
            {
                ConstructorInfo con = StringToType(className).GetConstructor(
                    StringToTypes(parameterTypeNames));
                return GenerateConstructorStub(con);
            }
            else
            {
                Type typ = StringToType(className);
                MethodInfo meth;
                if (parameterTypeNames != null)
                    meth = typ.GetMethod(methodName, StringToTypes(parameterTypeNames));
                else
                    meth = typ.GetMethod(methodName);
                if(meth == null) {
                    var knownMethods = typ.GetMethods().Select(x => x.Name).ToArray();
                    throw new ArgumentException(String.Format("Method {0}({1}) not found in type {2}({3}). Try with: {4}", methodName, parameterTypeNames, typ.Name, typ.Assembly.FullName, String.Join(",",knownMethods) ));
                    }
                return GenerateMethodStub(meth);
            }
        }

        /// <summary>
        /// Given the name of a delegate type, returns a function pointer to a delegate that,
        /// when called, instantiates delegate instances of the given delegate type when given
        /// a pointer to a Haskell function.
        /// </summary>
        public static IntPtr GetDelegateConstructorStub(string delegateTypeName)
        {
            Type delegateType = StringToType(delegateTypeName);
            return GenerateDelegateConstructorStub(delegateType);
        }

        /// <summary>
        /// Given the class and name of a field, returns a native function pointer to a
        /// delegate that returns the value of the field when invoked.
        /// </summary>
        public static IntPtr GetFieldGetStub(string className, string fieldName)
        {
            FieldInfo field = StringToType(className).GetField(fieldName);
            return GenerateFieldGetStub(field);
        }

        /// <summary>
        /// Given the class and name of a field, returns a native function pointer to a
        /// delegate that sets the value of the field when invoked.
        /// </summary>
        public static IntPtr GetFieldSetStub(string className, string fieldName)
        {
            FieldInfo field = StringToType(className).GetField(fieldName);
            return GenerateFieldSetStub(field);
        }

        /// <summary>
        /// Given a value type, returns a native function pointer to a method that
        /// boxes values of the given value type.
        /// </summary>
        public static IntPtr GetBoxStub(string typeName)
        {
            Type typeToBox = StringToType(typeName);
            return GenerateBoxStub(typeToBox);
        }

        #endregion

        #region Foreign object references (object in-table)

        /// <summary>
        /// Maps object identifiers to .NET references.  Allows foreign object identifiers
        /// to be dereferenced to .NET object references.  Also ensures that .NET objects
        /// referred to from Haskell are kept alive.
        /// </summary>
        static Dictionary<long, object> _inTable = new Dictionary<long, Object>();

        static long _nextId = 1;

        /// <summary>
        /// Registers the given object in the 'in table' and returns the object id
        /// that was assigned to it.
        /// </summary>
        public static long RegisterObject(object o)
        {
            if (o == null)
                return 0;

            if (o is bool?) // HACK for Nullable<bool>
            {
                bool b = (bool)o;
                return b ? 1 : 2;
            }

            lock (_inTable)
            {
                _inTable.Add(_nextId, o);
                return _nextId++;
            }
        }

        public static object GetObject(long oId)
        {
            if (oId == 0) // 0 represents a null reference
                return null;

            if (oId == 1) // 1 represents boxed true
                return true; // TODO: Return pre-boxed instance?
            if (oId == 2) // 0 represents boxed false
                return false;

            lock (_inTable)
            {
                object o;
                if (_inTable.TryGetValue(oId, out o))
                    return o;
                else
                {
                    throw new ArgumentException("No object exists with id: " + oId);
                    // FIXME: This exception will occur in the current implementation of the
                    //        bridge if a Haskell garbage collection (and finalization) runs
                    //        while a Haskell-implemented delegate is returning an object.
                    //        Given that this condition tends not to occur with the current
                    //        implementation of the GHC RTS, and that most delegates in .NET
                    //        don't return a value at all, I'm leaving the fix for later.
                }
            }
        }

        [UnmanagedFunctionPointer(CallingConvention.Cdecl)]
        public delegate void ReleaseObjectDelegate(long oId);
        private static ReleaseObjectDelegate _ReleaseObjectDelegate = ReleaseObject;

        public static void ReleaseObject(long oId)
        {
            lock (_inTable)
            {
                _inTable.Remove(oId);
            }
        }

        #endregion

        #region Managed delegate references (function pointer in-table)

        /// <summary>
        /// Maintains references to any .NET delegates that have a native function pointer
        /// referring to them (as obtained using Marshal.GetFunctionPointerForDelegate), so
        /// that they are not collected prematurely.
        /// </summary>
        private static Dictionary<IntPtr, Delegate> _dotNetFunPtrDelegates = new Dictionary<IntPtr, Delegate>();

        /// <summary>
        /// Returns a native function pointer for calling the given .NET delegate.  A
        /// reference to the delegate is stored in _dotNetFunPtrDelegates to prevent
        /// the delegate from being garbage collected while the function pointer is
        /// still being used.
        /// </summary>
        private static IntPtr GetDotNetFunPtrForDelegate(Delegate d) // TODO: Perhaps rename 'RegisterDelegate'
        {
            IntPtr funPtr = Marshal.GetFunctionPointerForDelegate(d);
            lock (_dotNetFunPtrDelegates)
                _dotNetFunPtrDelegates.Add(funPtr, d);
            return funPtr;
        }

        /// <summary>
        /// This method is called to indicate that the given native function pointer
        /// will no longer be called from Haskell.  It allows the associated .NET
        /// delegate to be garbage collected provided there are no other references
        /// to it.
        /// </summary>
        public static void FreeDotNetFunPtr(IntPtr funPtr) // TODO: Perhaps rename 'ReleaseDelegate'
        {
            lock (_dotNetFunPtrDelegates)
                _dotNetFunPtrDelegates.Remove(funPtr);
        }

        #endregion

        #region Stub method generation

        /// <summary>
        /// Generates a dynamic method of the given name and signature, containing the instructions
        /// produced by 'ilWriter'.  A delegate to the method, is returned to the caller as a native
        /// function pointer.
        /// </summary>
        /// <remarks>
        /// This method also writes the method to the 'Stubs' class in 'Dynamic.dll' for debugging
        /// purposes.
        /// </remarks>
        private static IntPtr GenerateDynamicMethod(string methodName,
            DelegateSignature methodSignature, ILWriterDelegate ilWriter)
        {
            if (true)
            {
                // Optional: generate an implementation of the stub method inside the 'Stubs'
                //           class (which is saved to 'Dynamic.dll') for debugging purposes.
                MethodBuilder savedMethod = _stubsTypeBuilder.DefineMethod(methodName, MethodAttributes.Public,
                    methodSignature.ReturnType, methodSignature.ParameterTypes);
                ilWriter(savedMethod.GetILGenerator());
            }

            // Generate a dynamic method of the given name and signature, and the
            // IL instructions given by 'ilWriter', then return a delegate to the
            // method as a function pointer.

            // [stubReturnType] [classType]_[methodname]([classType] this, [args...]):
            DynamicMethod method = new DynamicMethod(methodName, methodSignature.ReturnType,
                methodSignature.ParameterTypes, typeof(Driver));
            ilWriter(method.GetILGenerator());

            return GetDotNetFunPtrForDelegate(method.CreateDelegate(methodSignature.ToDelegateType()));
        }

        /// <summary>
        /// Returns a native function pointer to a wrapper stub that accepts foreign
        /// parameters, marshals them, calls the indicated constructor, and returns the
        /// resulting object instance (marshaled as necessary).
        /// </summary>
        /// <remarks>
        /// The returned function pointer should be freed with 'FreeDotNetFunPtr'.
        /// When used to construct a value type, 'con' may be null, in which case
        /// no constructor is called (the value is just initialised to zero).
        /// </remarks>
        public static IntPtr GenerateConstructorStub(ConstructorInfo con)
        {
            Type type = con.DeclaringType;

            if (!type.IsValueType && con == null)
                throw new ArgumentNullException("'con' cannot be null if creating a reference type.");

            // Generate a dynamic method that does the following:
            //
            //     Int64 [classType]New([args...])
            //     {
            //         [classType] o = new [classType]([args... using GetObject ... ]);
            //         (box o if it is a value type)
            //         return Driver.RegisterObject(o);
            //     }

            // Signature of the stub method returned (as a delegate) by this function
            DelegateSignature methodSignature = new DelegateSignature(
                typeof(Int64),
                con == null ? Type.EmptyTypes :
                              ConvertToStubTypes(Util.MapParametersToTypes(con.GetParameters())));

            return GenerateDynamicMethod(type.Name + "New", methodSignature,
                delegate(ILGenerator ilg)
                {
                    if (con == null) // Initialise object to zero?
                    {
                        // Initialise the object in a local variable
                        ilg.DeclareLocal(type);
                        ilg.Emit(OpCodes.Ldloca_S, (byte)0);
                        ilg.Emit(OpCodes.Initobj, type);

                        // Load the object onto the stack
                        ilg.Emit(OpCodes.Ldloc_0);
                    }
                    else // Call object constructor:
                    {
                        // Load (and unmarshal), the arguments to the constructor stub
                        EmitParameterLoading(ilg, 0, con.GetParameters());

                        // Call the constructor, i.e. 'o = new [classType]([unmarshaled args])'
                        ilg.Emit(OpCodes.Newobj, con);
                    }

                    // Return the new object (marshaled as an index)
                    EmitToStub(ilg, type);
                    ilg.Emit(OpCodes.Ret);
                });
        }

        /// <summary>
        /// Returns a native function pointer to a stub method that calls the given
        /// method, marshaling arguments as necessary.
        /// </summary>
        /// <remarks>
        /// The returned function pointer should be freed with 'FreeDotNetFunPtr'.
        /// </remarks>
        public static IntPtr GenerateMethodStub(MethodInfo meth)
        {
            Type classType = meth.DeclaringType;

            // Generate a dynamic method that does the following:
            //
            //     [stubReturnType] [classType]_[methodName]([classType] this, [args...])
            //       OR (if a static method)
            //     [stubReturnType] [classType]_[methodName]([args...])
            //     {
            //         [resultType] r = this.[methodName]([marshaledThis], [marshaled args]);
            //           OR (if a static method)
            //         [resultType] r = [className].[methodName]([marshaled args]);
            //
            //         return r; OR return Driver.RegisterObject(r);
            //     }

            // Signature of the stub method returned (as a delegate) by this function
            DelegateSignature methodSignature = new DelegateSignature(
                ConvertToStubType(meth.ReturnParameter.ParameterType),
                meth.IsStatic ? ConvertToStubTypes(Util.MapParametersToTypes(meth.GetParameters())) :
                    Util.ConcatArray<Type>(
                        ConvertToStubType(meth.DeclaringType),
                        ConvertToStubTypes(Util.MapParametersToTypes(meth.GetParameters()))));

            return GenerateDynamicMethod(classType.Name + "_" + meth.Name, methodSignature,
                delegate(ILGenerator ilg)
                {
                    // Load (and unmarshal), the arguments to the method stub, then call the real method
                    if (meth.IsStatic)
                    {
                        EmitParameterLoading(ilg, 0, meth.GetParameters());
                        ilg.Emit(OpCodes.Call, meth);
                    }
                    else
                    {
                        EmitParameterLoading(ilg, 0, meth.DeclaringType);
                        EmitParameterLoading(ilg, 1, meth.GetParameters());
                        ilg.Emit(OpCodes.Callvirt, meth);
                    }

                    // Unmarshal and return the result
                    EmitMarshaledReturn(ilg, meth.ReturnParameter);
                });
        }

        /// <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:
            //
            //     Int64 [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(Int64), 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>
        /// Returns a native function pointer to a stub method that retrieves the value
        /// of the given static or instance field.
        /// </summary>
        /// <remarks>
        /// The returned function pointer should be freed with 'FreeDotNetFunPtr'.
        /// </remarks>
        public static IntPtr GenerateFieldGetStub(FieldInfo field)
        {
            // Signature of the stub method returned (as a delegate) by this function
            DelegateSignature methodSignature = new DelegateSignature(
                ConvertToStubType(field.FieldType),
                field.IsStatic ? Type.EmptyTypes : new Type[] { ConvertToStubType(field.DeclaringType) });

            return GenerateDynamicMethod(field.DeclaringType.Name + "_field_get_" + field.Name, methodSignature,
                delegate(ILGenerator ilg)
                {
                    if (field.IsStatic)
                    {
                        if (field.IsLiteral)
                        {
                            // FIXME: Move literal calculation to the generator, and add
                            //        support for literal values in the bridge (i.e.
                            //        values other than 'Obj ObjectId's
                            object literalValue = field.GetRawConstantValue();
                            if (literalValue is Int32)
                                ilg.Emit(OpCodes.Ldc_I4, (Int32)literalValue);
                        }
                        else
                            ilg.Emit(OpCodes.Ldsfld, field);
                    }
                    else
                    {
                        // Load (and unmarshal) the argument to the method stub, then load the field value
                        EmitParameterLoading(ilg, 0, field.DeclaringType);
                        ilg.Emit(OpCodes.Ldfld, field);
                    }

                    // Unmarshal and return the result
                    EmitToStub(ilg, field.FieldType);
                    ilg.Emit(OpCodes.Ret);
                });
        }

        /// <summary>
        /// Returns a native function pointer to a stub method that sets the value
        /// of the given static or instance field.
        /// </summary>
        /// <remarks>
        /// The returned function pointer should be freed with 'FreeDotNetFunPtr'.
        /// </remarks>
        public static IntPtr GenerateFieldSetStub(FieldInfo field)
        {
            // Signature of the stub method returned (as a delegate) by this function
            DelegateSignature methodSignature = new DelegateSignature(
                typeof(void),
                field.IsStatic ?
                    new Type[] { ConvertToStubType(field.FieldType) } :
                    new Type[] { ConvertToStubType(field.DeclaringType), ConvertToStubType(field.FieldType) });

            return GenerateDynamicMethod(field.DeclaringType.Name + "_field_set_" + field.Name, methodSignature,
                delegate(ILGenerator ilg)
                {
                    if (field.IsStatic)
                    {
                        // Load (and unmarshal) the field value from the stub call
                        EmitParameterLoading(ilg, 0, field.FieldType);
                        ilg.Emit(OpCodes.Stsfld, field);
                    }
                    else
                    {
                        // Load (and unmarshal) the instance argument and field value from the stub call
                        EmitParameterLoading(ilg, 0, field.DeclaringType);
                        EmitParameterLoading(ilg, 1, field.FieldType);
                        ilg.Emit(OpCodes.Stfld, field);
                    }

                    ilg.Emit(OpCodes.Ret);
                });
        }

        /// <summary>
        /// Returns a native function pointer to a stub method that returns a
        /// reference to the given value (boxing value types as necessary).
        /// </summary>
        /// <remarks>
        /// The returned function pointer should be freed with 'FreeDotNetFunPtr'.
        /// </remarks>
        public static IntPtr GenerateBoxStub(Type typeToBox)
        {
            // Signature of the stub method returned (as a delegate) by this function
            DelegateSignature methodSignature = new DelegateSignature(
                typeof(Int64), new Type[] { ConvertToStubType(typeToBox) });

            return GenerateDynamicMethod("box_" + typeToBox.Name, methodSignature,
                delegate(ILGenerator ilg)
                {
                    // Load the (unboxed) value
                    EmitParameterLoading(ilg, 0, typeToBox);

                    if (typeToBox.IsValueType)
                    {
                        // Box the type value to as an object
                        ilg.Emit(OpCodes.Box, typeToBox);
                    }

                    // Marshal the object instance out as an object index
                    EmitToStub(ilg, typeof(object));
                    ilg.Emit(OpCodes.Ret);
                });
        }

        #endregion

        #region Parameter and result marshaling

        private static bool IsMarshaledByIndex(Type t)
        {
            return !t.IsPrimitive && t != typeof(void) && t != typeof(string);
        }


        private static bool isMono = Type.GetType ("Mono.Runtime") != null;

        /// <summary>
        /// Given an array of parameters (say of a constructor, or method), returns the
        /// array of types that a corresponding wrapper stub would accept.
        /// </summary>
        private static Type[] ConvertToStubTypes(Type[] types)
        {
            return Util.MapArray<Type, Type>(ConvertToStubType, types);
        }

        private static Type ConvertToStubType(Type type)
        {
            if (IsMarshaledByIndex(type))
                return typeof(Int64);
            else
                return type;
        }

        /// <summary>
        /// Emits code (via the given IL generator) to load a single parameter of the given
        /// type from the given argument index and on to the stack.  It ensures that object
        /// types (which are marshaled by index), are resolved to the appropriate .NET object
        /// instance.
        /// </summary>
        private static void EmitParameterLoading(ILGenerator ilg, int argumentIndex, Type parameterType)
        {
            Util.EmitLdarg(ilg, argumentIndex);
            EmitFromStub(ilg, parameterType);
        }

        // Converts a value on the stack from a stub stub to the associated 'real' .NET type
        /// <summary>
        /// Emits code to convert a value on the stack from a stub type to the associated
        /// 'real' .NET type.
        /// </summary>
        /// <remarks>
        /// For example, when called for the 'Button' type, code is emitted to convert an
        /// Int64 object identifier into a Button; but when called with the 'String' type
        /// no code is emitted at all since the stub type matches the desired .NET type
        /// exactly.
        /// </remarks>
        private static void EmitFromStub(ILGenerator ilg, Type valueType)
        {
            if (IsMarshaledByIndex(valueType))
            {
                // [valueType]x = ([valueType])GetObject(value):

                // Call GetObject on the object index to obtain the object instance
                ilg.Emit(OpCodes.Call, MemberInfos.Driver_GetObject);

                // Cast from Object to the appropriate type for the value (unboxing if necessary)
                ilg.Emit(OpCodes.Unbox_Any, valueType);

                // Note, the above instruction is equivalent to:
                //
                //   if (valueType.IsValueType)
                //   {
                //       ilg.Emit(OpCodes.Unbox, valueType);
                //       ilg.Emit(OpCodes.Ldobj);
                //   }
                //   else
                //       ilg.Emit(OpCodes.Castclass, valueType);
                //
            }
            else
            {
                // Leave value as is
            }
        }

        /// <summary>
        /// Emits code (via the given IL generator) to load parameters of the given types
        /// from the arguments of the method (starting with 'startingArgument') and on to
        /// the stack.  It ensures that object types (which are marshaled by index), are
        /// resolved to the appropriate .NET object instance.
        /// </summary>
        private static void EmitParameterLoading(ILGenerator ilg, int startingArgument,
            IEnumerable<ParameterInfo> parameterInfos)
        {
            int argumentIndex = startingArgument;
            foreach (ParameterInfo parameterInfo in parameterInfos)
            {
                Type parameterType = parameterInfo.ParameterType;
                Util.EmitLdarg(ilg, argumentIndex++);
                EmitFromStub(ilg, parameterType);
            }
        }

        private static void EmitToStub(ILGenerator ilg, Type type)
        {
            if (IsMarshaledByIndex(type))
            {
                if (type.IsValueType)
                {
                    // Box the value type for passing it to RegisterObject
                    ilg.Emit(OpCodes.Box, type);
                }

                // Marshal the object instance out as an object index, by
                // calling RegisterObject
                ilg.Emit(OpCodes.Call, MemberInfos.Driver_RegisterObject);
            }
            else
            {
                // Leave value as is
            }
        }

        /// <summary>
        /// Emits code (via the given IL generator) to return the value on the top of the
        /// stack, knowing that its type is given by 'returnParameterInfo'.  It ensures
        /// that object types (which are marshaled by index), are returned as an index.
        /// </summary>
        private static void EmitMarshaledReturn(ILGenerator ilg, ParameterInfo returnParameterInfo)
        {
            Type parameterType = returnParameterInfo.ParameterType;
            EmitToStub(ilg, parameterType);
            ilg.Emit(OpCodes.Ret);
        }

        #endregion

        #region Delegate wrappers

        /// <summary>
        /// Maintains a cache of the delegate wrapper types that have been generated.
        /// </summary>
        private static Dictionary<string, Type> _delegateWrapperTypes =
            new Dictionary<string, Type>();

        private static Type GetDelegateWrapperType(Type delegateType)
        {
            string wrapperTypeName = delegateType.Name + "Wrapper";
            lock (_delegateWrapperTypes)
            {
                Type type;
                if (!_delegateWrapperTypes.TryGetValue(wrapperTypeName, out type))
                {
                    // Could not find wrapper class of appropriate type in the cache: create one
                    type = CreateDelegateWrapperType(wrapperTypeName, delegateType);
                    _delegateWrapperTypes.Add(wrapperTypeName, type);
                }
                return type;
            }
        }

        /// <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();
        }

        #endregion

        #region DelegateSignature implementation

        public struct DelegateSignature
        {
            private Type _returnType;
            private Type[] _parameterTypes;

            public Type ReturnType
            {
                get { return _returnType; }
            }

            public Type[] ParameterTypes
            {
                get { return _parameterTypes; }
            }

            public DelegateSignature(Type returnType, Type[] parameterTypes)
            {
                _returnType = returnType;
                _parameterTypes = parameterTypes;
            }

            public override string ToString()
            {
                StringBuilder sb = new StringBuilder();
                foreach (Type parameter in _parameterTypes)
                {
                    sb.Append(parameter.Name);
                    sb.Append("To");
                }
                sb.Append(_returnType.Name);
                return sb.ToString();
            }

            public static DelegateSignature FromDelegateType(Type delegateType)
            {
                MethodInfo invokeMethod = delegateType.GetMethod("Invoke");
                return new DelegateSignature(
                    invokeMethod.ReturnType,
                    Util.MapParametersToTypes(invokeMethod.GetParameters()));
            }

            #region Delegate creation

            /// <summary>
            /// Maintains a cache of the delegate types that have been generated.
            /// </summary>
            private static Dictionary<string, Type> _delegateTypes =
                new Dictionary<string, Type>();

            /// <summary>
            /// Returns (after creating, if necessary) a delegate type of the given type signature.
            /// </summary>
            public Type ToDelegateType()
            {
                string delegateName = ToString() + "Delegate";
                lock (_delegateTypes)
                {
                    Type type;
                    if (!_delegateTypes.TryGetValue(delegateName, out type))
                    {
                        // Could not find delegate of appropriate type in the cache: create one
                        type = CreateDelegateType(delegateName);
                        _delegateTypes.Add(delegateName, type);
                    }
                    return type;
                }
            }

            private void ApplyMarshalAsAttribute(Type type, int paramIndex, MethodBuilder methodBuilder)
            {
                if (type == null)
                    return;
                else if (type == typeof(string))
                {
                    ParameterBuilder pb = methodBuilder.DefineParameter(paramIndex, ParameterAttributes.None, null);
                    pb.SetCustomAttribute(
                        new CustomAttributeBuilder(
                            typeof(MarshalAsAttribute).GetConstructor(new Type[] { typeof(UnmanagedType) }),
                            new object[] { UnmanagedType.BStr }
                        )
                    );
                }
            }

            /// <summary>
            /// Dynamically creates (and returns the type of) a delegate class with the given
            /// name and type signature.
            /// </summary>
            private Type CreateDelegateType(string name)
            {
                TypeBuilder typeBuilder = Driver._dynamicModuleBuilder.DefineType(name,
                    TypeAttributes.Class | TypeAttributes.Public |
                    TypeAttributes.Sealed | TypeAttributes.AnsiClass |
                    TypeAttributes.AutoClass, typeof(System.MulticastDelegate));

                // Add a '[UnmanagedFunctionPointer(CallingConvention.Cdecl)]' attribute to the delegate
                typeBuilder.SetCustomAttribute(new CustomAttributeBuilder(
                    typeof(UnmanagedFunctionPointerAttribute).GetConstructor(new Type[] { typeof(CallingConvention) }),
                    new object[] { CallingConvention.Cdecl }));

                ConstructorBuilder constructorBuilder = typeBuilder.DefineConstructor(
                    MethodAttributes.RTSpecialName | MethodAttributes.HideBySig |
                    MethodAttributes.Public, CallingConventions.Standard,
                    new Type[] { typeof(object), typeof(System.IntPtr) });
                constructorBuilder.SetImplementationFlags(MethodImplAttributes.Runtime | MethodImplAttributes.Managed);

                MethodBuilder methodBuilder = typeBuilder.DefineMethod("Invoke", MethodAttributes.Public |
                    MethodAttributes.HideBySig | MethodAttributes.NewSlot |
                    MethodAttributes.Virtual,
                    ReturnType, ParameterTypes);
                methodBuilder.SetImplementationFlags(MethodImplAttributes.Runtime | MethodImplAttributes.Managed);

                // For the return type and any parameter types
                for (int i = 0; i < ParameterTypes.Length + 1; i++)
                {
                    Type currentParam;
                    if (i == 0)
                        currentParam = ReturnType;
                    else
                        currentParam = ParameterTypes[i - 1];

                    ApplyMarshalAsAttribute(currentParam, i, methodBuilder);
                }
                return typeBuilder.CreateType();
            }

            #endregion
        }

        #endregion

        private static Dictionary<String, Assembly> LoadedAssemblies = new Dictionary<String, Assembly>();

        /// Helper function to load an assembly from bytes
        public static Assembly LoadAssemblyFromBytes(IntPtr ptr, int len) {
            byte[] bytes = new byte[len];
            Marshal.Copy(ptr,bytes,0,len);
            Assembly res = System.Reflection.Assembly.Load(bytes, null, System.Security.SecurityContextSource.CurrentAppDomain);
            LoadedAssemblies.Add(res.GetName().FullName, res);
            return res;
        }

        private static Assembly GetLoadedAssembly(AssemblyName assName)  {
            Assembly a;
            if (LoadedAssemblies.TryGetValue(assName.FullName, out a))
                return a;
            else{
                System.Console.WriteLine("About to crash. Attach debugger or press Enter");
                System.Console.ReadLine();
                System.Diagnostics.Debugger.Break();
                throw new ArgumentException("GetLoadedAssembly: " + assName.FullName, "Known assemblies: " + String.Join(",", LoadedAssemblies.Select(kv => kv.Key)));
            }
        }
        public static Type StringToType(string s)
        {
            Type t = Type.GetType(s);
            t = t ?? Type.GetType(s,(assName => GetLoadedAssembly(assName)), ((ass, tn, ci) => ass.GetType(tn,ci)), true);
            return t;
        }

        public static Type[] StringToTypes(string s)
        {
            return Util.MapArray<string, Type>(delegate(string t)
                                               { return StringToType(t); },
                                               s.Split(new char[] { ';' }, StringSplitOptions.RemoveEmptyEntries));
        }
    }

    /// <summary>
    /// A delegate for the signature of the Haskell function 'freeHaskellFunPtr'.
    /// </summary>
    [UnmanagedFunctionPointer(CallingConvention.Cdecl)]
    public delegate void FreeHaskellFunPtrDelegate(IntPtr funPtr);

    /// <summary>
    /// A delegate for code the emits IL instructions on demand.
    /// </summary>
    public delegate void ILWriterDelegate(ILGenerator ilg);

    /// <summary>
    /// Stores references to commonly used reflection object instances.
    /// </summary>
    internal static class MemberInfos
    {
        public static readonly MethodInfo Type_GetTypeFromHandle =
            typeof(Type).GetMethod("GetTypeFromHandle");

        public static readonly ConstructorInfo Object_ctor =
            typeof(object).GetConstructor(Type.EmptyTypes);

        public static readonly MethodInfo Marshal_GetDelegateForFunctionPointer =
            typeof(Marshal).GetMethod("GetDelegateForFunctionPointer", new Type[] { typeof(IntPtr), typeof(Type) });

        public static readonly MethodInfo Marshal_GetFunctionPointerForDelegate =
            typeof(Marshal).GetMethod("GetFunctionPointerForDelegate", new Type[]{ typeof(Delegate) });

        public static readonly MethodInfo Marshal_StringToHGlobalUni =
            typeof(Marshal).GetMethod("StringToHGlobalUni");

        public static readonly MethodInfo Marshal_StringToHGlobalAnsi =
            typeof(Marshal).GetMethod("StringToHGlobalAnsi");

        public static readonly FieldInfo Driver_FreeHaskellFunPtr =
            typeof(Driver).GetField("FreeHaskellFunPtr", BindingFlags.Static | BindingFlags.Public);

        public static readonly MethodInfo Driver_RegisterObject =
            typeof(Driver).GetMethod("RegisterObject", BindingFlags.Static | BindingFlags.Public);

        public static readonly MethodInfo Driver_GetObject =
            typeof(Driver).GetMethod("GetObject", BindingFlags.Static | BindingFlags.Public);

        public static readonly MethodInfo FreeHaskellFunPtrDelegate_Invoke =
            typeof(FreeHaskellFunPtrDelegate).GetMethod("Invoke");
    }

    internal static class Util
    {

        public static T[] ConcatArray<T>(T[] a, T[] b)
        {
            T[] r = new T[a.Length + b.Length];
            for (int i = 0; i < a.Length; i++)
                r[i] = a[i];
            for (int i = 0; i < b.Length; i++)
                r[a.Length + i] = b[i];
            return r;
        }

        public static T[] ConcatArray<T>(T x, T[] b)
        {
            T[] r = new T[1 + b.Length];
            r[0] = x;
            for (int i = 0; i < b.Length; i++)
                r[1 + i] = b[i];
            return r;
        }

        public static B[] MapArray<A, B>(Func<A, B> f, A[] xs)
        {
            B[] r = new B[xs.Length];
            for (int i = 0; i < xs.Length; i++)
                r[i] = f(xs[i]);
            return r;
        }

        public delegate B Func<A, B>(A x1);

        public static Type[] MapParametersToTypes(ParameterInfo[] parameters)
        {
            return MapArray<ParameterInfo, Type>(
                delegate(ParameterInfo p) { return p.ParameterType; },
                parameters);
        }

        public static void EmitLdarg(ILGenerator ilg, int argumentIndex)
        {
            if (argumentIndex == 0) ilg.Emit(OpCodes.Ldarg_0);
            else if (argumentIndex == 1) ilg.Emit(OpCodes.Ldarg_1);
            else if (argumentIndex == 2) ilg.Emit(OpCodes.Ldarg_2);
            else if (argumentIndex == 3) ilg.Emit(OpCodes.Ldarg_3);
            else if (argumentIndex <= 255) ilg.Emit(OpCodes.Ldarg_S, (byte)argumentIndex);
            else ilg.Emit(OpCodes.Ldarg, (int)argumentIndex);
        }

    }
}