//
// Salsa Binding Generator
//
// Licence:   BSD3 (see LICENSE)
//

using System;
using System.Collections.Generic;
using System.Text;
using System.IO;
using System.Reflection;
using System.Linq;

namespace Generator
{
    class Generator
    {
        static void Main(string[] args)
        {
            if (args.Length == 0)
            {
                Console.WriteLine("Usage: {0} [input-files]",
                    Path.GetFileName(Environment.GetCommandLineArgs()[0]));
            }
            else
                new Generator().Run(args);
        }

        private TextWriter w;

        private Set<string> _labels = new Set<string>();
        private Set<string> _invokers = new Set<string>();

        /// <summary>
        /// Instead of using long strings for identifiers inside the binding, we generate 
        /// shorter, unique ids using this dictionary.
        /// </summary>
        private Dictionary<string, long> _uniqueIds = new Dictionary<string, long>();

        private int _typeCodeMaxValue = 15;
        private int _typeCodeValue = 7; // Leave first 7 codes available for primitive types

        /// <summary>
        /// Set of types that are required by the types generated so far.
        /// </summary>
        private Set<Type> _requiredTypes = new Set<Type>();

        /// <summary>
        /// Set of types that have been generated so far.
        /// </summary>
        private Set<Type> _generatedTypes = new Set<Type>();

        /// <summary>
        /// Set of types that were originally requested to be generated.
        /// </summary>
        private Set<Type> _requestedTypes = new Set<Type>();

        private Dictionary<Type, List<string>> _requestedMembers = new Dictionary<Type, List<string>>();

        private long GetUnique(params string[] keys)
        {
            string key = Util.Join("\0", keys); // Combine the keys
            long id;
            if (_uniqueIds.TryGetValue(key, out id))
                return id;
            else
            {
                id = _uniqueIds.Count + 1;
                _uniqueIds.Add(key, id);
                return id;
            }
        }

        /// <summary>
        /// Returns a unique type-level list of booleans, which can be used as a type code.
        /// </summary>
        private string GetNextTypeCode()
        {
            const int encodingBase = 15; 
            // Note: This is not 16, thus leaving 'DF' available to use as a delimiter in type codes
            //       for parameterised types (like arrays).

            // Build a string for type code (as a Haskell type)
            StringBuilder s = new StringBuilder();
            int x = _typeCodeValue;
            int b = _typeCodeMaxValue;
            while (b > 1)
            {
                s.AppendFormat("{0} ::: ", 
                    new string[] { 
                        "D0", "D1", "D2", "D3", "D4", "D5", "D6", "D7", 
                        "D8", "D9", "DA", "DB", "DC", "DD", "DE", "DF" }[x % encodingBase]);
                x /= encodingBase;
                b /= encodingBase; 
            }
            s.Append("TNil");

            // Obtain the next type code
            _typeCodeValue += 1;
            if (_typeCodeValue == _typeCodeMaxValue)
            {
                _typeCodeValue = 0;
                _typeCodeMaxValue *= encodingBase;
            }

            return s.ToString();
        }

        private void RequestAll(Type t)
        {
            _requestedTypes.Add(t);

            List<string> ms;// = new List<string>();
            if (!_requestedMembers.TryGetValue(t, out ms))
                ms = new List<string>();

            foreach (MemberInfo mi in t.GetMembers(BindingFlags.Public |
                BindingFlags.Instance | BindingFlags.Static | BindingFlags.DeclaredOnly))
                ms.Add(mi.Name);  

            _requestedMembers[t] = ms;
        }

        private void Request(Type t, params string[] members)
        {
            _requestedTypes.Add(t);

            List<string> ms;// = new List<string>();
            if (!_requestedMembers.TryGetValue(t, out ms))
                ms = new List<string>();
            ms.AddRange(members);
            _requestedMembers[t] = ms;
        }

        /// <summary>
        /// Returns true iff the given member 'm' in type 't' has been requested,
        /// either directly or indirectly (i.e. if 'm' is inherited from a 
        /// requested member).
        /// </summary>
        private bool IsMemberRequested(Type targetType, string m)
        {
            List<string> ms;

            foreach (Type t in EnumerateAncestors(targetType))
            {
                // Was the member requested in a supertype?
                if (_requestedMembers.TryGetValue(t, out ms))
                {
                    if (ms.Contains(m))
                        return true;
                }
            }
            return false;
        }

        private void ReadImports(string path)
        {
            List<Assembly> references = new List<Assembly>();
            references.Add(Assembly.GetAssembly(typeof(object)));

            using (StreamReader r = File.OpenText(path))
            {
                string line;
                while ((line = r.ReadLine()) != null)
                {
                    if (line.Trim() == string.Empty) continue;
                    if (line.StartsWith("--") || line.StartsWith("#"))
                        continue;

                    string[] sides = line.Split(new char[] { ':', ' ', '\t' }, 2,
                        StringSplitOptions.RemoveEmptyEntries);


                    if (sides[0] == "reference")
                    {
                        if (sides.Length != 2)
                            throw new Exception("Must specify assembly name after 'reference'");
                        references.Add(Assembly.LoadFile(Path.GetFullPath(sides[1])));
                    }
                    else
                    {
                        string[] members;
                        if (sides.Length > 1)
                            members = sides[1].Split(new char[] { ',', ' ', '\t' },
                                StringSplitOptions.RemoveEmptyEntries);
                        else
                            members = new string[0];

                        bool foundType = false;
                        foreach (Assembly a in references)
                        {
                            Type t = a.GetType(sides[0]);
                            if (t != null)
                            {
                                if (members.Length > 0 && members[0] == "*")
                                    RequestAll(t);
                                else
                                    Request(t, members);
                                foundType = true;
                                break;
                            }
                        }

                        if (!foundType)
                            throw new Exception(string.Format(
                                "The type '{0}' does not exist (are you missing an assembly reference?)",
                                sides[0]));
                    }
                }
            }
        }

        private void Run(string[] args)
        {
            string outputPath = @".";

            foreach (string arg in args)
                ReadImports(arg);

            // Require System.Array (the base class of all arrays), and its
            // CreateInstance method, because the Salsa library uses it to 
            // instantiate arrays.
//            Request(typeof(System.Array), "CreateInstance");

            using (w = File.CreateText(Path.Combine(outputPath, "Bindings.hs")))
            {
                // Explicitly request all supertypes too (since their members are inherited 
                // by the requested types)
                foreach (Type requestedType in Enumerable.ToList(_requestedTypes))
                {
                    foreach (Type superRequestedType in EnumerateAncestors(requestedType))
                    {
                        _requestedTypes.Add(superRequestedType);
                        
                        if (_requestedMembers.ContainsKey(requestedType))
                            Request(superRequestedType, _requestedMembers[requestedType].ToArray());
                    }
                }

                foreach (Type requestedType in _requestedTypes)
                {
                    RequireType(requestedType);
                    if (!_requestedMembers.ContainsKey(requestedType))
                        _requestedMembers.Add(requestedType, new List<string>());
                }

                w.WriteLine("{-# LANGUAGE ForeignFunctionInterface, MultiParamTypeClasses, FlexibleInstances, TypeFamilies, TypeOperators, TypeSynonymInstances, UndecidableInstances #-}");

                w.WriteLine("module {0} (", "Bindings");
                w.WriteLine("  module Labels");
                w.WriteLine("  ) where");
                w.WriteLine();
                w.WriteLine("import Labels");
                w.WriteLine("import Foreign.Salsa.Binding");

                while (_requiredTypes.Count > 0)
                {
                    Type t = _requiredTypes.Pop();
                    if (_generatedTypes.Contains(t)) continue; // Already generated

                    if (IsUnsupportedType(t)) continue;
                    if (IsPrim(t)) continue; // TODO: Support boxed primitive types later.

                    Console.WriteLine("Binding " + t.ToString());
                    WriteClass(t);

                    _generatedTypes.Add(t);
                }

                Console.WriteLine("Generated bindings for {0} classes", _generatedTypes.Count);
            }

            using (w = File.CreateText(Path.Combine(outputPath, "Labels.hs")))
            {
                w.WriteLine("{-# LANGUAGE EmptyDataDecls #-}"); 

                w.WriteLine("module Labels where");
                w.WriteLine("import Foreign.Salsa (invoke)");
                w.WriteLine();
                WriteLabels();
                WriteInvokers();
            }
        }

        /// <summary>
        /// Indicates that a particular type should be generated (if it hasn't
        /// already been generated).
        /// </summary>
        private void RequireType(Type t)
        {
            if (!_generatedTypes.Contains(t))
                _requiredTypes.Add(t);
        }

        private void WriteClass(Type targetType)
        {
//            if (targetType.IsArray)
//            {
//                // Explicit bindings for array types are not generated by the code generator.
//                // We only need to generate bindings for the element type, the base type
//                // (System.Array) (which is always generated) and the parameterised 'Arr t'
//                // type (see end of this method).
//
//                // Require the element type of the array
//                RequireType(targetType.GetElementType());
//
//                return;
//            }

            string classLabel = TypeToLabel(targetType);

            w.WriteLine();
            w.WriteLine("--");
            w.WriteLine("-- Class: {0}", targetType.FullName);
            w.WriteLine("--");
            w.WriteLine();


            //
            // Write a Salsa.Typeable instance for this class
            //
            // Note: Type.GetType always returns the same instance for a given type, so it is 
            //       safe to use 'unsafePerformIO' below.
            //
            w.WriteLine("instance Typeable {0} where", classLabel);
            w.WriteLine("  typeOf _ = unsafePerformIO $ type_GetType \"{0}\"", targetType.AssemblyQualifiedName);
            w.WriteLine();

            // TODO: Cache result of 'typeOf' in an IORef?

            {
                //
                // Instance and static methods
                //
                {
                    // Build a list of relevant instance methods for the target class.
                    // Filter out 'override' methods and 'get/set/add/remove' methods.
                    // Also filter out methods with the same name and signature in a base 
                    // class (i.e. hide by signature).
                    List<MemberInfo> relevantMethods = new List<MemberInfo>();

                    // Go down the inheritance tree from object to the target type
                    foreach (Type implementedType in Enumerable.Reverse(EnumerateAncestors(targetType)))
                    {
                        foreach (MethodInfo mi in implementedType.GetMethods(
                            BindingFlags.DeclaredOnly | BindingFlags.Public |
                            BindingFlags.Instance | BindingFlags.Static))
                        {
                            if (mi.IsSpecialName) continue; // Skip get/set/add/remove methods

                            // Skip overridden (virtual but not a new slot) methods
                            if (mi.IsVirtual && (mi.Attributes & MethodAttributes.NewSlot) == 0) continue;

                            // Ignore methods containing parameters of unsupported types, or an 
                            // unsupported result type
                            if (IsUnsupportedType(mi.ReturnType) ||
                                Enumerable.Any(mi.GetParameters(),
                                    delegate(ParameterInfo pi) { return IsUnsupportedType(pi.ParameterType); }))
                                continue;

                            // Remove any methods (from base classes) with this name and signature
                            // (i.e. implement hide-by-signature semantics, like C#)
                            relevantMethods.RemoveAll(delegate(MemberInfo mi2)
                            {
                                return HasSameSignature((MethodInfo)mi, (MethodInfo)mi2);
                            });

                            relevantMethods.Add(mi);
                        }
                    }

                    // Enumerate over the method groups in the relevant instance methods,
                    // generating bindings for each group
                    foreach (IGrouping<string, MemberInfo> mg in Enumerable.GroupBy<MemberInfo, string>(
                        relevantMethods, delegate(MemberInfo mi)
                        {
                            return (((MethodInfo)mi).IsStatic ? "static " : "") + mi.Name;
                        }))
                    {
                        if (!IsMemberRequested(targetType, Enumerable.First(mg).Name)) continue;

                        w.WriteLine("-- " + mg.Key);

                        WriteMethodGroup(mg, targetType);
                    }
                }

                //
                // Constructors
                //
                if (typeof(Delegate).IsAssignableFrom(targetType))
                {
                    // Delegate constructors are special, since they accept a normal 
                    // Haskell function as an argument
                    WriteDelegateConstructor(targetType);
                }
                else
                {
                    // Build a list of relevant constructors for the target class (if any)
                    List<ConstructorInfo> relevantConstructors = new List<ConstructorInfo>();
                    foreach (ConstructorInfo ci in targetType.GetConstructors())
                    {
                        // Ignore methods containing parameters of unsupported types
                        if (Enumerable.Any(ci.GetParameters(),
                            delegate(ParameterInfo pi) { return IsUnsupportedType(pi.ParameterType); }))
                            continue;

                        relevantConstructors.Add(ci);
                    }

                    if (relevantConstructors.Count > 0)
                    {
                        // Generate bindings for the constructors (treated as a single method group)
                        w.WriteLine("-- Constructors");
                        WriteConstructorGroup(relevantConstructors, targetType);
                        w.WriteLine();
                    }
                }

                //
                // Instance and static properties
                //
                {
                    // Build a list accessors for accessable, non-indexed, properties in the target class
                    List<AccessorInfo<PropertyInfo>> relevantPropertyAccessors =
                        new List<AccessorInfo<PropertyInfo>>();

                    // Go down the inheritance tree from object to the target type
                    foreach (Type implementedType in Enumerable.Reverse(EnumerateAncestors(targetType)))
                    {
                        foreach (PropertyInfo pi in implementedType.GetProperties(
                            BindingFlags.DeclaredOnly | BindingFlags.Public |
                            BindingFlags.Instance | BindingFlags.Static))
                        {
                            // Ignore indexed properties (since they're currently out of scope, FIXME)
                            if (pi.GetIndexParameters().Length > 0)
                                continue;

                            // Ignore properties of unsupported types
                            if (IsUnsupportedType(pi.PropertyType)) continue;

                            foreach (MethodInfo mi in pi.GetAccessors())
                            {
                                // Skip static properties declared outside of the target type
                                AccessorInfo<PropertyInfo> ai = new AccessorInfo<PropertyInfo>(
                                    mi == pi.GetGetMethod() ? AccessorType.Get : AccessorType.Set,
                                    pi, mi);

                                // Remove any shadowed properties (from base classes)
                                relevantPropertyAccessors.RemoveAll(
                                    delegate(AccessorInfo<PropertyInfo> ai2)
                                    {
                                        return HasSameSignature(ai.Accessor, ai2.Accessor);
                                    });

                                relevantPropertyAccessors.Add(ai);
                            }
                        }
                    }

                    // Enumerate over the properties and generate attribute bindings for each
                    // pair of get/set accessors
                    foreach (IGrouping<string, AccessorInfo<PropertyInfo>> mg in
                        Enumerable.GroupBy<AccessorInfo<PropertyInfo>, string>(
                            relevantPropertyAccessors,
                            delegate(AccessorInfo<PropertyInfo> ai)
                            {
                                return (ai.Accessor.IsStatic ? "static " : "") + ai.Owner.Name;
                            }))
                    {
                        if (!IsMemberRequested(targetType, Enumerable.First(mg).Owner.Name)) continue;

                        WriteProperty(mg, targetType);
                    }
                }

                //
                // Static and instance events
                //
                {
                    // Build a list accessors for events in the target class
                    List<AccessorInfo<EventInfo>> relevantEventAccessors =
                        new List<AccessorInfo<EventInfo>>();

                    // Go down the inheritance tree from object to the target type
                    foreach (Type implementedType in Enumerable.Reverse(EnumerateAncestors(targetType)))
                    {
                        foreach (EventInfo ei in implementedType.GetEvents(
                            BindingFlags.DeclaredOnly | BindingFlags.Public |
                            BindingFlags.Instance | BindingFlags.Static))
                        {
                            // Ignore events of unsupported types
                            if (IsUnsupportedType(ei.EventHandlerType)) continue;

                            foreach (MethodInfo mi in new MethodInfo[] {
                            ei.GetAddMethod(), ei.GetRemoveMethod() })
                            {
                                // Skip static events declared outside of the target type
                                AccessorInfo<EventInfo> ai = new AccessorInfo<EventInfo>(
                                    mi == ei.GetAddMethod() ? AccessorType.Add : AccessorType.Remove,
                                    ei, mi);

                                // Remove any shadowed events (from base classes)
                                relevantEventAccessors.RemoveAll(
                                    delegate(AccessorInfo<EventInfo> ai2)
                                    {
                                        return HasSameSignature(ai.Accessor, ai2.Accessor);
                                    });

                                relevantEventAccessors.Add(ai);
                            }
                        }
                    }

                    // Enumerate over the events and generate attribute bindings for each
                    // pair of add/remove accessors
                    foreach (IGrouping<string, AccessorInfo<EventInfo>> mg in
                        Enumerable.GroupBy<AccessorInfo<EventInfo>, string>(
                            relevantEventAccessors,
                            delegate(AccessorInfo<EventInfo> ai)
                            {
                                return (ai.Accessor.IsStatic ? "static " : "") + ai.Owner.Name;
                            }))
                    {
                        if (!IsMemberRequested(targetType, Enumerable.First(mg).Owner.Name)) continue;

                        WriteEvent(mg, targetType);
                    }
                }

                //
                // Instance and static fields
                //
                {
                    // Build a list accessible fields in the target class
                    List<FieldInfo> relevantFields = new List<FieldInfo>();

                    // Go down the inheritance tree from object to the target type
                    foreach (Type implementedType in Enumerable.Reverse(EnumerateAncestors(targetType)))
                    {
                        foreach (FieldInfo fi in implementedType.GetFields(
                            BindingFlags.DeclaredOnly | BindingFlags.Public |
                            BindingFlags.Instance | BindingFlags.Static))
                        {
                            // Ignore fields of unsupported types
                            if (IsUnsupportedType(fi.FieldType)) continue;

                            // Remove any shadowed fields (from base classes)
                            relevantFields.RemoveAll(
                                delegate(FieldInfo fi2)
                                {
                                    return fi.Name == fi2.Name;
                                });

                            relevantFields.Add(fi);
                        }
                    }

                    // Enumerate over the fields and generate bindings for each
                    foreach (FieldInfo fi in relevantFields)
                    {
                        if (!IsMemberRequested(targetType, fi.Name)) continue;

                        WriteField(fi, targetType);
                    }
                }
            }

            //
            // Ancestors
            //

            List<Type> supertypes = new List<Type>();

            foreach (Type t in EnumerateAncestors(targetType))
                supertypes.Add(t);

            supertypes.AddRange(targetType.GetInterfaces());

            // Remove any unsupported types from 'supertypes'
            foreach (Type t in Enumerable.ToList(supertypes))
            {
                if (IsUnsupportedType(t))
                    supertypes.Remove(t);
            }

            w.WriteLine("type instance SupertypesOf {0} = {1}", 
                ToHaskellType(targetType),
                Util.JoinSuffix(" ::: ", Enumerable.Select<Type, string>(supertypes,
                    delegate(Type t) { return ToHaskellType(t); }), "TNil"));

            foreach (Type supertype in supertypes)
                RequireType(supertype);

            //
            // Type code
            //
            string typeCode = GetNextTypeCode();
            w.WriteLine("type instance TyCode {0} = {1}", ToHaskellType(targetType), typeCode);
            w.WriteLine("type instance FromTyCode ({1}) = {0}", ToHaskellType(targetType), typeCode); // EXPERIMENTAL
            w.WriteLine();

//            if (targetType == typeof(System.Array))
//            {
//                //
//                // Delegate the members of any array type (i.e. any 'Arr t') to System.Array
//                //
//                w.WriteLine();
//                w.WriteLine("--");
//                w.WriteLine("-- 'Arr t' to 'System.Array' delegation code");
//                w.WriteLine("--");
//                w.WriteLine();
//                Console.WriteLine(string.Join(", ", Assembly.GetExecutingAssembly().GetManifestResourceNames()));
//                using (StreamReader r = new StreamReader(
//                    Assembly.GetExecutingAssembly().GetManifestResourceStream(typeof(Generator), "Array.hs")))
//                {
//                    string line;
//                    while ((line = r.ReadLine()) != null)
//                        w.WriteLine(line);
//                }
//            }
        }

        /// <summary>
        /// Generates bindings for a delegate constructor for the given delegate type.
        /// </summary>
        private void WriteDelegateConstructor(Type delegateType)
        {
            string classLabel = TypeToLabel(delegateType);

            w.WriteLine();
            w.WriteLine("--");
            w.WriteLine("-- Delegate: {0}", delegateType.Name);
            w.WriteLine("--");
            w.WriteLine();

            if (delegateType != typeof(Delegate) &&
                delegateType != typeof(MulticastDelegate))
            {
                ConstructorInfo constructorCi = delegateType.GetConstructors()[0];
                MethodInfo invokerMi = delegateType.GetMethod("Invoke");

                string target = TypeToLabel(delegateType);

                string stubFunction = ToStubName(constructorCi);
                string wrapperFunction = "wrap_" + stubFunction;
                string wrapperType = "Type_" + wrapperFunction;

                ParameterInfo[] parameters = GetParameters(invokerMi);

                // Generate the base type signature for Haskell implementation of the delegate
                w.WriteLine("type {0} = {1}", wrapperType,
                    Util.JoinSuffix(" -> ", Enumerable.Select<ParameterInfo, string>(parameters,
                        delegate(ParameterInfo pi) { return ToBaseType(pi.ParameterType); }),
                        ToBaseReturnType(GetMemberReturnType(invokerMi))));

                w.WriteLine("foreign import ccall \"wrapper\" {0} :: {1} -> (IO (FunPtr {1}))",
                    wrapperFunction, wrapperType);
                w.WriteLine();

                // Generate the delegate-object-generating stub function
                w.WriteLine("{{-# NOINLINE {0} #-}}", stubFunction);
                w.WriteLine("{0} :: {1} -> IO ObjectId", stubFunction, wrapperType);
                w.WriteLine("{0} = unsafePerformIO $ getDelegateConstructorStub", stubFunction);
                w.WriteLine("    \"{0}\"", delegateType.AssemblyQualifiedName);
                w.WriteLine("    {0}", wrapperFunction);
                w.WriteLine();

                // Generate the 'delegate' instance for calling the delegate constructor
                w.WriteLine("instance Delegate {0} where", target);
                w.WriteLine("    type DelegateT {0} = {1}", target,
                    Util.JoinSuffix(" -> ", Enumerable.Select<ParameterInfo, string>(parameters,
                        delegate(ParameterInfo pi) { return ToHaskellType(pi.ParameterType); }),
                        ToReturnType(GetMemberReturnType(invokerMi))));
                w.WriteLine("    delegate _ handler = {0} (marshalFn{1} handler) >>= unmarshal",
                    stubFunction, parameters.Length);
                w.WriteLine();
            }

            w.WriteLine();
        }
        
        /// <summary>
        /// Generates bindings for a method group containing: all instance methods,
        /// all static methods, or all instance constructors.
        /// </summary>
        private void WriteMethodGroup(IEnumerable<MemberInfo> members, Type forType)
        {
            MemberInfo firstMi = Enumerable.First(members);

            Console.WriteLine("  {0}", firstMi.Name);

            ParameterInfo[] parameters = GetParameters(firstMi);
            Type returnType = GetMemberReturnType(firstMi);
            bool isStatic = IsMemberStatic(firstMi);

            string label = GetMemberLabel(firstMi);
            string target = isStatic ? TypeToLabel(forType) : ToHaskellType(forType);

            // Output the parameter lists for the members of the method group
            w.WriteLine("type instance Candidates {0} {1} = {2}",
                target, label,
                Util.JoinSuffix(" ::: ", Enumerable.Select<MemberInfo, string>(members,
                    delegate(MemberInfo mi) { return ToListType(GetParameters(mi)); }), "TNil"));

            // Output instances for invoking each method group member
            foreach (MemberInfo mi in members)
                WriteMethod(mi, forType);
            w.WriteLine();

            // Require the return type of this method
            RequireType(returnType);
        }

        /// <summary>
        /// Generates bindings for a group of instance constructors.
        /// </summary>
        private void WriteConstructorGroup(IEnumerable<ConstructorInfo> members, Type forType)
        {
            ConstructorInfo firstCi = Enumerable.First(members);
            string target = TypeToLabel(forType);
            string label = "Ctor";

            // Output the parameter lists for the constructors
            w.WriteLine("type instance Candidates {0} {1} = {2}",
                target, label,
                Util.JoinSuffix(" ::: ", Enumerable.Select<ConstructorInfo, string>(members,
                    delegate(ConstructorInfo ci) { return ToListType(ci.GetParameters()); }), "TNil"));

            // Output instances for invoking each constructor
            foreach (ConstructorInfo ci in members)
                WriteMethod(ci, forType);
        }

        /// <summary>
        /// Generate bindings for a static method, instance method, or instance constructor,
        /// for use in a particular class (which, in the case of an instance method, may be a
        /// descendant of the class in which the method was declared).
        /// </summary>
        private void WriteMethod(MemberInfo mi, Type forType)
        {
            // If the method was declared on the target type (forType), then produce
            // the FFI stub function (which is called by Invoker instances down the
            // hierarchy)
            if (mi.DeclaringType == forType)
                WriteMethodStub(mi);

            // Invoker instance:
            w.WriteLine("instance Invoker {0} {1} {2} where",
                IsMemberStatic(mi) ? TypeToLabel(forType) : ToHaskellType(forType),
                GetMemberLabel(mi), ToTupleType(GetParameters(mi)));
            w.WriteLine("  type Result {0} {1} {2} = {3}",
                IsMemberStatic(mi) ? TypeToLabel(forType) : ToHaskellType(forType),
                GetMemberLabel(mi), ToTupleType(GetParameters(mi)),
                ToReturnType(GetMemberReturnType(mi)));
            w.WriteLine("  rawInvoke = {0}", ToMethodMarshaler(mi));

            // Require any parameter types for this method/constructor
            foreach (ParameterInfo pi in GetParameters(mi))
                RequireType(pi.ParameterType);
        }
        
        /// <summary>
        /// Returns true iff the given member should be treated as a static member.
        /// Static methods, static properties, and instance constructors are all
        /// treated as static members.
        /// </summary>
        private bool IsMemberStatic(MemberInfo mi)
        {
            if (mi is ConstructorInfo)
                return true;
            if (mi is MethodInfo)
                return ((MethodInfo)mi).IsStatic;
            if (mi is FieldInfo)
                return ((FieldInfo)mi).IsStatic;
            throw new ArgumentException("Expected a ConstructorInfo, MethodInfo or FieldInfo.");
        }

        /// <summary>
        /// Returns the Haskell code for a function that calls the given method, 
        /// constructor, or property accessor, marshaling the arguments and result 
        /// value as necessary.
        /// </summary>
        private string ToMethodMarshaler(MemberInfo mi)
        {
            return string.Format("marshalMethod{0}{1} {2}",
                GetParameters(mi).Length, IsMemberStatic(mi) ? "s" : "i",
                ToStubName(mi));
        }

        /// <summary>
        /// Generates an FFI stub function for calling a particular .NET method
        /// or property accessor.
        /// </summary>
        private void WriteMethodStub(MemberInfo mi)
        {
            // TODO: Perhaps use unboxed string literals?

            string stubFunction = ToStubName(mi);
            string stubType = "Type_" + stubFunction;
            string makeFunction = "make_" + stubFunction;

            w.WriteLine();
            w.WriteLine("-- Foreign Interface Stub for {0}.{1}:",
                mi.DeclaringType.Name, mi.Name);
            w.WriteLine("type {0} = {1}{2}", stubType,
                IsMemberStatic(mi) ? "" : (ToBaseType(mi.DeclaringType) + " -> "),
                Util.JoinSuffix(" -> ", Enumerable.Select<ParameterInfo, string>(GetParameters(mi),
                    delegate(ParameterInfo pi) { return ToBaseType(pi.ParameterType); }),
                    ToBaseReturnType(GetMemberReturnType(mi))));
            w.WriteLine("foreign import ccall \"dynamic\" {0} :: FunPtr {1} -> {1}",
                makeFunction, stubType);
            w.WriteLine();
            w.WriteLine("{{-# NOINLINE {0} #-}}", stubFunction);
            w.WriteLine("{0} :: {1}", stubFunction, stubType);
            w.WriteLine("{0} = {1} $ unsafePerformIO $ getMethodStub", stubFunction, makeFunction);
            w.WriteLine("    \"{0}\" \"{1}\"", mi.DeclaringType.AssemblyQualifiedName, mi.Name);
            w.WriteLine("    \"{0}\"",
                Util.Join(";", Enumerable.Select<ParameterInfo, string>(GetParameters(mi),
                    delegate(ParameterInfo pi) { return ToQualifiedType(pi.ParameterType); })));
            w.WriteLine();
        }

        /// <summary>
        /// Generates FFI stub functions for retrieving or setting a particular .NET field.
        /// </summary>
        private void WriteFieldStub(FieldInfo fi, AccessorType accessorType)
        {
            bool isGet = (accessorType == AccessorType.Get);
            string stubFunction = ToStubName(fi) + "_" + (isGet ? "get" : "set");
            string stubType = "Type_" + stubFunction;
            string makeFunction = "make_" + stubFunction;

            w.WriteLine();
            w.WriteLine("-- Field accessor stub for {0}.{1}:", fi.DeclaringType.Name, fi.Name);
            w.WriteLine("type {0} = {1}{2}{3}", 
                stubType,
                fi.IsStatic ? "" : (ToBaseType(fi.DeclaringType) + " -> "),
                isGet ? "" : (ToBaseType(fi.FieldType) + " -> "),
                isGet ? ToBaseReturnType(fi.FieldType) : "IO ()");

            w.WriteLine("foreign import ccall \"dynamic\" {0} :: FunPtr {1} -> {1}",
                makeFunction, stubType);

            w.WriteLine();
            w.WriteLine("{{-# NOINLINE {0} #-}}", stubFunction);
            w.WriteLine("{0} :: {1}", stubFunction, stubType);
            w.WriteLine("{0} = {1} $ unsafePerformIO $ {2}", stubFunction, makeFunction,
                isGet ? "getFieldGetStub" : "getFieldSetStub");
            w.WriteLine("    \"{0}\" \"{1}\"", fi.DeclaringType.AssemblyQualifiedName, fi.Name);
            w.WriteLine();
        }

        private void WriteProperty(IEnumerable<AccessorInfo<PropertyInfo>> accessors, Type forType)
        {
            AccessorInfo<PropertyInfo> firstAccessor = Enumerable.First(accessors);
            bool isStatic = IsMemberStatic(firstAccessor.Accessor);

            string target = isStatic ? TypeToLabel(forType) : ToHaskellType(forType);
            string label = ToLabelType(firstAccessor.Owner.Name);

            w.WriteLine("instance Prop {0} {1} where", target, label);

            AccessorInfo<PropertyInfo> getAccessor = Enumerable.FirstOrDefault(accessors,
                delegate(AccessorInfo<PropertyInfo> ai) { return ai.Type == AccessorType.Get; });
            AccessorInfo<PropertyInfo> setAccessor = Enumerable.FirstOrDefault(accessors,
                delegate(AccessorInfo<PropertyInfo> ai) { return ai.Type == AccessorType.Set; });

            if (getAccessor != null)
            {
                w.WriteLine("    type PropGT {0} {1} = {2}", target, label,
                    ToHaskellType(getAccessor.Owner.PropertyType));
                w.WriteLine("    getProp t pn = {0} t pn ()", ToMethodMarshaler(getAccessor.Accessor));
            }
            else
            {
                w.WriteLine("    type PropGT {0} {1} = ()", target, label);
                w.WriteLine("    getProp _ _ = return ()"); // Return nothing
            }

            if (setAccessor != null)
            {
                w.WriteLine("    type PropST {0} {1} = {2}", target, label,
                    ToHaskellType(setAccessor.Owner.PropertyType));
                w.WriteLine("    setProp = {0}", ToMethodMarshaler(setAccessor.Accessor));
            }
            else
            {
                w.WriteLine("    type PropST {0} {1} = ()", target, label);
                w.WriteLine("    setProp _ _ _ = return ()"); // Do nothing
            }
            
            foreach (AccessorInfo<PropertyInfo> accessor in accessors)
            {
                // Generate the get/set stub caller (in declared type only)
                if (accessor.Accessor.DeclaringType == forType)
                    WriteMethodStub(accessor.Accessor);
            }

            w.WriteLine();
        }

        private void WriteEvent(IEnumerable<AccessorInfo<EventInfo>> accessors, Type forType)
        {
            AccessorInfo<EventInfo> firstAccessor = Enumerable.First(accessors);
            bool isStatic = IsMemberStatic(firstAccessor.Accessor);

            string target = isStatic ? TypeToLabel(forType) : ToHaskellType(forType);
            string label = ToLabelType(firstAccessor.Owner.Name);

            w.WriteLine("instance Event {0} {1} where", target, label);
            w.WriteLine("    type EventT {0} {1} = {2}", target, label,
                ToHaskellType(firstAccessor.Owner.EventHandlerType));

            foreach (AccessorInfo<EventInfo> accessor in accessors)
            {
                if (accessor.Type == AccessorType.Add)
                    w.WriteLine("    addEvent    = {0}", ToMethodMarshaler(accessor.Accessor));
                else // AccessorType.Remove
                    w.WriteLine("    removeEvent = {0}", ToMethodMarshaler(accessor.Accessor));
            }

            foreach (AccessorInfo<EventInfo> accessor in accessors)
            {
                // Generate the add/remove stub caller (in declared type only)
                if (accessor.Accessor.DeclaringType == forType)
                    WriteMethodStub(accessor.Accessor);
            }

            w.WriteLine();

            // Require the event type of this event
            RequireType(firstAccessor.Owner.EventHandlerType);
        }

        private void WriteField(FieldInfo field, Type forType)
        {
            bool isStatic = field.IsStatic;
            bool isReadOnly = field.IsLiteral || field.IsInitOnly;

            // TODO: Add support for literal fields.  The constant value from
            //       the metadata should be included in the generated code.

            string target = isStatic ? TypeToLabel(forType) : ToHaskellType(forType);
            string label = ToLabelType(field.Name);

            w.WriteLine("instance Prop {0} {1} where", target, label);

            w.WriteLine("    type PropGT {0} {1} = {2}", target, label, ToHaskellType(field.FieldType));
            w.WriteLine("    getProp t pn = marshalMethod0{0} {1}_get t pn ()",
                isStatic ? "s" : "i", ToStubName(field));

            if (!isReadOnly)
            {
                w.WriteLine("    type PropST {0} {1} = {2}", target, label, ToHaskellType(field.FieldType));
                w.WriteLine("    setProp = marshalMethod1{0} {1}_set", 
                    isStatic ? "s" : "i", ToStubName(field));
            }
            else
            {
                w.WriteLine("    type PropST {0} {1} = ()", target, label);
                w.WriteLine("    setProp _ _ _ = return ()"); // Do nothing
            }

            // Generate the get/set stub caller (in declared type only)
            if (field.DeclaringType == forType)
            {
                if (!isReadOnly)
                    WriteFieldStub(field, AccessorType.Set);
                WriteFieldStub(field, AccessorType.Get);
            }

            // For readonly fields, generate an IO-less method getting the value
            if (isReadOnly)
            {
                // Ensure that an invoker is generated for invoking the label with '#'
                ToInvoker(field.Name);

                w.WriteLine("type instance Candidates {0} {1} = TNil ::: TNil", target, label);

                w.WriteLine("instance Invoker {0} {1} () where", target, label);
                w.WriteLine("  type Result {0} {1} () = {2}", target, label, ToHaskellType(field.FieldType));
                w.WriteLine("  rawInvoke t m () = unsafePerformIO $ get t m ");
            }

            w.WriteLine();
        }

        private string ToHaskellType(Type t)
        {
            if (t == typeof(void)) return "()";
            if (t == typeof(int)) return "Int32";
            if (t == typeof(string)) return "String";
            if (t == typeof(bool)) return "Bool";
            if (t == typeof(Double)) return "Double";
            if (t == typeof(bool?)) return "(Maybe Bool)";
//            if (t.IsArray) 
//                return string.Format("(Obj (Arr {0}))", ToHaskellType(t.GetElementType()));
            return "(Obj " + TypeToLabel(t) + ")";
        }

        private string ToReturnType(Type t)
        {
            return "IO " + ToHaskellType(t);
        }

        /// <summary>
        /// Gives the low-level Haskell type for the given .NET type 't'.  This is the
        /// base type used in FFI declarations.
        /// </summary>
        private string ToBaseType(Type t)
        {
            if (t == typeof(void)) return "()";
            if (t == typeof(Int32)) return "Int32";
            if (t == typeof(String)) return "SalsaString";
            if (t == typeof(Boolean)) return "Bool";
            if (t == typeof(Double)) return "Double";
            return "ObjectId";
        }

        private string ToBaseReturnType(Type t)
        {
            return "IO " + ToBaseType(t);
        }

        private bool IsPrim(Type t)
        {
            return
                t == typeof(void) ||
                t == typeof(Int32) ||
                t == typeof(String) ||
                t == typeof(Boolean) ||
                t == typeof(Double);
        }

        private bool IsUnsupportedType(Type t)
        {
            return
                t.Name.StartsWith("_") ||
                t.IsByRef ||        // FIXME: Support this?
                t.IsPointer ||
                // Salsa doesn't support generic types yet, but there's a special case for Nullable<bool>
                (t.IsGenericType && t != typeof(Nullable<bool>)) ||
                t.IsGenericParameter ||
                t.IsArray; // Temporarily removed array support
//                // Salsa only supports arrays of non-generic types at present
//                (t.IsArray && IsUnsupportedType(t.GetElementType()));
        }

        /// <summary>
        /// Returns a tuple of high-level Haskell types corresponding to the given
        /// list of method parameters.
        /// </summary>
        private string ToTupleType(ParameterInfo[] ts)
        {
            return "(" + Util.Join(", ", Enumerable.Select<ParameterInfo, string>(ts,
                delegate(ParameterInfo pi) { return ToHaskellType(pi.ParameterType); } )) + ")";
        }

        /// <summary>
        /// Returns a type-level list of high-level Haskell types corresponding to 
        /// the given list of method parameters.
        /// </summary>
        private string ToListType(ParameterInfo[] ts)
        {
            return "(" + Util.JoinSuffix(" ::: ", Enumerable.Select<ParameterInfo, string>(ts,
                delegate(ParameterInfo pi) { return ToHaskellType(pi.ParameterType); } ), "TNil") + ")";
        }

        /// <summary>
        /// Returns the name of the raw FFI stub method associated with the given .NET method
        /// or constructor.  There is a unique stub name for every declared method overload,
        /// and constructor.
        /// </summary>
        private string ToStubName(MemberInfo mi)
        {
            string parameterDetails = "";
            if (mi is ConstructorInfo || mi is MethodInfo)
                parameterDetails = Util.Join(" ", Enumerable.Select<ParameterInfo, string>(GetParameters(mi),
                        delegate(ParameterInfo pi) { return pi.ParameterType.AssemblyQualifiedName; }));

            return string.Format("stub_{0}",
                GetUnique("stub",
                    mi.DeclaringType.AssemblyQualifiedName,
                    mi.Name,
                    parameterDetails));
        }

        /// <summary>
        /// Returns the name of the FFI wrapper function that is used to wrap Haskell 
        /// functions that implement the given .NET delegate type.
        /// </summary>
        private string ToWrapperName(Type dt)
        {
            return string.Format("wrap_{0}",
                GetUnique("wrap", dt.AssemblyQualifiedName));
        }

        /// <summary>
        /// Returns a string that uniquely identifies the given type.  It is 
        /// used to retrieve stub functions for the particular type at runtime.
        /// </summary>
        private string ToQualifiedType(Type t)
        {
            // Unless the type is in mscorlib, use the (long) assembly qualified name
            if (t.Assembly == typeof(object).Assembly)
                return t.FullName;
            else
                return t.AssemblyQualifiedName;
        }

        private ParameterInfo[] GetParameters(MemberInfo mi)
        {
            if (mi is MethodInfo)
                return ((MethodInfo)mi).GetParameters();
            if (mi is ConstructorInfo)
                return ((ConstructorInfo)mi).GetParameters();
            throw new ArgumentException("Must be a MethodInfo or ConstructorInfo.", "mi");
        }

        private Type GetMemberReturnType(MemberInfo mi)
        {
            if (mi is MethodInfo)
                return ((MethodInfo)mi).ReturnType;
            if (mi is ConstructorInfo)
                return ((ConstructorInfo)mi).DeclaringType;
            throw new ArgumentException("Must be a MethodInfo or ConstructorInfo.", "mi");
        }

        private string GetMemberLabel(MemberInfo mi)
        {
            if (mi is MethodInfo)
                return MethodToLabel((MethodInfo)mi);
            if (mi is ConstructorInfo)
                return "Ctor";
            throw new ArgumentException("Must be a MethodInfo or ConstructorInfo.", "mi");
        }

        /// <summary>
        /// Returns true iff the given methods have the same name, number and type of 
        /// parameters.
        /// </summary>
        private bool HasSameSignature(MethodInfo mi1, MethodInfo mi2)
        {
            if (mi1.Name != mi2.Name) return false;
            ParameterInfo[] pi1 = mi1.GetParameters();
            ParameterInfo[] pi2 = mi2.GetParameters();
            if (pi1.Length != pi2.Length) return false;
            for (int i = 0; i < pi1.Length; i++)
            {
                if (pi1[i].ParameterType != pi2[i].ParameterType)
                    return false;
            }
            return true;
        }

        /// <summary>
        /// Returns an irrefutable Haskell pattern for matching a value of the given type.
        /// 'index' is included in the identified used (if any).
        /// </summary>
        private string ToPattern(Type t, int index)
        {
            if (t == typeof(void)) return "()";
            if (t == typeof(int) || t == typeof(bool) || t == typeof(string))
                return string.Format("a{0}", index);
            return string.Format("(Obj a{0})", index);
        }

        /// <summary>
        /// Enumerate ancestors of 't', starting with 't' and finishing with object.
        /// </summary>
        private IEnumerable<Type> EnumerateAncestors(Type t)
        {
            while (t != null)
            {
                yield return t;
                t = t.BaseType;
            }
        }

        private string MethodToLabel(MethodInfo mi)
        {
            ToInvoker(mi.Name);
            return ToLabelType(mi.Name);
        }

        private string TypeToLabel(Type t)
        {
            if (IsUnsupportedType(t)) return ToLabelType("NotSupported"); 

            if (t.IsNested && t.DeclaringType != null)
            {
                // FIXME: This only handles one level of nested classes 
                //        (and it doesn't handle nested generic types)
                return ToLabelType(t.DeclaringType.Name + "_" + t.Name);
            }
            else if (t.IsGenericType && t.GetGenericTypeDefinition() == typeof(Nullable<>))
            {
                return string.Format("(Maybe {0})", TypeToLabel(t.GetGenericArguments()[0]));
            }
            else
                return ToLabelType(t.Name);
        }

        private string ToLabelHelper(string s)
        {
            if (string.IsNullOrEmpty(s))
                throw new ArgumentException("Expected non-empty string.");
            s = char.ToUpper(s[0]) + s.Substring(1);
            if (!_labels.Contains(s) && 
                s != "Object" && s != "Type" && s != "Array") // These labels are defined in the Salsa library
                _labels.Add(s);
            return s;
        }

        private string ToLabelValue(string s)
        {
            return "_" + ToLabelHelper(s);
        }

        private string ToLabelType(string s)
        {
            return ToLabelHelper(s) + "_";
        }

        private void WriteLabels()
        {
            w.WriteLine("-- Labels for .NET types, methods, properties, fields and events");
            foreach (string label in _labels)
                w.WriteLine("data {0,-25}", ToLabelType(label));
            w.WriteLine();
            foreach (string label in _labels)
                w.WriteLine("{0,-30} = undefined :: {1}", ToLabelValue(label), ToLabelType(label));
            w.WriteLine();
        }

        private string ToInvoker(string s)
        {
            s = Util.ToLowerFirst(s);
            if (!_invokers.Contains(s))
                _invokers.Add(s);
            return "_" + s;
        }

        private void WriteInvokers()
        {
            w.WriteLine("-- Functions for invoking methods with '#'");
            foreach (string invoker in _invokers)
            {
                // Output an invoker (and a unit invoker, for convenience and consistency)
                w.WriteLine("{0} args target = invoke target {1} args", ToInvoker(invoker), ToLabelValue(invoker));
                w.WriteLine("{0}_ target = invoke target {1} ()", ToInvoker(invoker), ToLabelValue(invoker));
            }
            w.WriteLine();
        }
    }

    public static class Util
    {
        public static string Join(string separator, IEnumerable<string> xs)
        {
            StringBuilder sb = new StringBuilder();
            foreach (string x in xs)
            {
                sb.Append(x);
                sb.Append(separator);
            }
            if (sb.Length > 0) sb.Length -= separator.Length;
            return sb.ToString();
        }

        public static string JoinSuffix(string separator, IEnumerable<string> xs, string end)
        {
            StringBuilder sb = new StringBuilder();
            foreach (string x in xs)
            {
                sb.Append(x);
                sb.Append(separator);
            }
            sb.Append(end);
            return sb.ToString();
        }

        public static string ToLowerFirst(string s)
        {
            if (s == "") return "";
            return s.Substring(0, 1).ToLower() + s.Substring(1);
        }

        public static string ToUpperFirst(string s)
        {
            if (s == "") return "";
            return s.Substring(0, 1).ToUpper() + s.Substring(1);
        }
    }

    public class AccessorInfo<T> where T : MemberInfo
    {
        private AccessorType _type;
        private T _owner;
        private MethodInfo _accessor;

        public AccessorInfo(AccessorType type, T owner, MethodInfo accessor)
        {
            _type = type;
            _owner = owner;
            _accessor = accessor;
        }

        public AccessorType Type
        {
            get { return _type; }
        }

        public MethodInfo Accessor
        {
            get { return _accessor; }
        }

        public T Owner
        {
            get { return _owner; }
        }
    }

    public enum AccessorType { Get, Set, Add, Remove };
}