Interface dispatch (#100)

WoofWare.PawPrint.Domain/TypeConcretisation.fs

@@ -53,7 +53,7 @@ module AllConcreteTypes =
 
     let findExistingConcreteType
         (concreteTypes : AllConcreteTypes)
-        (asm : AssemblyName, ns : string, name : string, generics : ConcreteTypeHandle ImmutableArray as key)
+        (asm : AssemblyName, ns : string, name : string, generics : ConcreteTypeHandle ImmutableArray)
         : ConcreteTypeHandle option
         =
         concreteTypes.Mapping
@@ -166,6 +166,40 @@ module ConcreteActivePatterns =
             | _ -> None
         | _ -> None
 
+    let (|ConcreteObj|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option =
+        match handle with
+        | ConcreteTypeHandle.Concrete id ->
+            match concreteTypes.Mapping |> Map.tryFind id with
+            | Some ct ->
+                if
+                    ct.Assembly.Name = "System.Private.CoreLib"
+                    && ct.Namespace = "System"
+                    && ct.Name = "Object"
+                    && ct.Generics.IsEmpty
+                then
+                    Some ()
+                else
+                    None
+            | None -> None
+        | _ -> None
+
+    let (|ConcreteValueType|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option =
+        match handle with
+        | ConcreteTypeHandle.Concrete id ->
+            match concreteTypes.Mapping |> Map.tryFind id with
+            | Some ct ->
+                if
+                    ct.Assembly.Name = "System.Private.CoreLib"
+                    && ct.Namespace = "System"
+                    && ct.Name = "ValueType"
+                    && ct.Generics.IsEmpty
+                then
+                    Some ()
+                else
+                    None
+            | None -> None
+        | _ -> None
+
     let (|ConcreteBool|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option =
         match handle with
         | ConcreteTypeHandle.Concrete id ->
@@ -322,7 +356,7 @@ module TypeConcretization =
         (key : AssemblyName * string * string)
         : ConcreteTypeHandle option
         =
-        let (asm, ns, name) = key
+        let asm, ns, name = key
         findExistingType concreteTypes asm ns name ImmutableArray.Empty
 
     // Helper function to create and add a ConcreteType to the context
@@ -377,7 +411,7 @@ module TypeConcretization =
             // Need to load the assembly
             match typeRef.ResolutionScope with
             | TypeRefResolutionScope.Assembly assyRef ->
-                let newAssemblies, loadedAssy = loadAssembly currentAssembly assyRef
+                let newAssemblies, _ = loadAssembly currentAssembly assyRef
 
                 let newCtx =
                     { ctx with
@@ -561,8 +595,8 @@ module TypeConcretization =
         (loadAssembly :
             AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
         (assembly : AssemblyName)
-        (typeGenerics : ConcreteTypeHandle ImmutableArray)
-        (methodGenerics : ConcreteTypeHandle ImmutableArray)
+        (typeGenerics : ImmutableArray<ConcreteTypeHandle>)
+        (methodGenerics : ImmutableArray<ConcreteTypeHandle>)
         (typeDefn : TypeDefn)
         : ConcreteTypeHandle * ConcretizationContext<'corelib>
         =
@@ -658,8 +692,8 @@ module TypeConcretization =
         (loadAssembly :
             AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
         (assembly : AssemblyName)
-        (typeGenerics : ConcreteTypeHandle ImmutableArray)
-        (methodGenerics : ConcreteTypeHandle ImmutableArray)
+        (typeGenerics : ImmutableArray<ConcreteTypeHandle>)
+        (methodGenerics : ImmutableArray<ConcreteTypeHandle>)
         (genericDef : TypeDefn)
         (args : ImmutableArray<TypeDefn>)
         : ConcreteTypeHandle * ConcretizationContext<'corelib>
@@ -817,8 +851,8 @@ module Concretization =
         (loadAssembly :
             AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
         (assembly : AssemblyName)
-        (typeArgs : ConcreteTypeHandle ImmutableArray)
-        (methodArgs : ConcreteTypeHandle ImmutableArray)
+        (typeArgs : ImmutableArray<ConcreteTypeHandle>)
+        (methodArgs : ImmutableArray<ConcreteTypeHandle>)
         (types : ImmutableArray<TypeDefn>)
         : ImmutableArray<ConcreteTypeHandle> * TypeConcretization.ConcretizationContext<'corelib>
         =
@@ -841,8 +875,8 @@ module Concretization =
         (loadAssembly :
             AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
         (assembly : AssemblyName)
-        (typeArgs : ConcreteTypeHandle ImmutableArray)
-        (methodArgs : ConcreteTypeHandle ImmutableArray)
+        (typeArgs : ImmutableArray<ConcreteTypeHandle>)
+        (methodArgs : ImmutableArray<ConcreteTypeHandle>)
         (signature : TypeMethodSignature<TypeDefn>)
         : TypeMethodSignature<ConcreteTypeHandle> * TypeConcretization.ConcretizationContext<'corelib>
         =
@@ -859,7 +893,7 @@ module Concretization =
             let handle, newCtx =
                 TypeConcretization.concretizeType ctx loadAssembly assembly typeArgs methodArgs paramType
 
-            paramHandles.Add (handle)
+            paramHandles.Add handle
             ctx <- newCtx
 
         let newSignature =
@@ -876,7 +910,7 @@ module Concretization =
     /// Helper to ensure base type assembly is loaded
     let rec private ensureBaseTypeAssembliesLoaded
         (loadAssembly :
-            AssemblyName -> AssemblyReferenceHandle -> (ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly))
+            AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
         (assemblies : ImmutableDictionary<string, DumpedAssembly>)
         (assyName : AssemblyName)
         (baseTypeInfo : BaseTypeInfo option)
@@ -910,9 +944,9 @@ module Concretization =
             AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
         (assemblies : ImmutableDictionary<string, DumpedAssembly>)
         (baseTypes : BaseClassTypes<DumpedAssembly>)
-        (method : WoofWare.PawPrint.MethodInfo<TypeDefn, GenericParamFromMetadata, TypeDefn>)
-        (typeArgs : ConcreteTypeHandle ImmutableArray)
-        (methodArgs : ConcreteTypeHandle ImmutableArray)
+        (method : WoofWare.PawPrint.MethodInfo<'ty, GenericParamFromMetadata, TypeDefn>)
+        (typeArgs : ImmutableArray<ConcreteTypeHandle>)
+        (methodArgs : ImmutableArray<ConcreteTypeHandle>)
         : WoofWare.PawPrint.MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle> *
           AllConcreteTypes *
           ImmutableDictionary<string, DumpedAssembly>
@@ -1042,10 +1076,9 @@ module Concretization =
         // Map generics to handles
         let genericHandles =
             method.Generics
-            |> Seq.mapi (fun i _ -> methodArgs.[i])
-            |> ImmutableArray.CreateRange
+            |> ImmutableArray.map (fun (gp, md) -> methodArgs.[gp.SequenceNumber])
 
-        let concretizedMethod : MethodInfo<_, _, ConcreteTypeHandle> =
+        let concretizedMethod : MethodInfo<_, _, _> =
             {
                 DeclaringType = concretizedDeclaringType
                 Handle = method.Handle

WoofWare.PawPrint.Domain/TypeInfo.fs

@@ -1,5 +1,6 @@
 namespace WoofWare.PawPrint
 
+open System
 open System.Collections.Generic
 open System.Collections.Immutable
 open System.Reflection
@@ -80,6 +81,8 @@ type TypeInfo<'generic, 'fieldGeneric> =
         /// </summary>
         TypeDefHandle : TypeDefinitionHandle
 
+        DeclaringType : TypeDefinitionHandle
+
         /// <summary>
         /// The assembly in which this type is defined.
         /// </summary>
@@ -92,6 +95,19 @@ type TypeInfo<'generic, 'fieldGeneric> =
         ImplementedInterfaces : InterfaceImplementation ImmutableArray
     }
 
+    member this.IsInterface = this.TypeAttributes.HasFlag TypeAttributes.Interface
+
+    member this.IsNested =
+        [
+            TypeAttributes.NestedPublic
+            TypeAttributes.NestedPrivate
+            TypeAttributes.NestedFamily
+            TypeAttributes.NestedAssembly
+            TypeAttributes.NestedFamANDAssem
+            TypeAttributes.NestedFamORAssem
+        ]
+        |> List.exists this.TypeAttributes.HasFlag
+
     override this.ToString () =
         $"%s{this.Assembly.Name}.%s{this.Namespace}.%s{this.Name}"
 
@@ -172,6 +188,15 @@ type BaseClassTypes<'corelib> =
 
 [<RequireQualifiedAccess>]
 module TypeInfo =
+    let rec fullName (get : TypeDefinitionHandle -> TypeInfo<_, _>) (ty : TypeInfo<'a, 'b>) =
+        if ty.IsNested then
+            let parent = get ty.DeclaringType |> fullName get
+            $"%s{parent}.{ty.Name}"
+        else if not (String.IsNullOrEmpty ty.Namespace) then
+            $"{ty.Namespace}.{ty.Name}"
+        else
+            ty.Name
+
     let withGenerics<'a, 'b, 'field> (gen : 'b ImmutableArray) (t : TypeInfo<'a, 'field>) : TypeInfo<'b, 'field> =
         {
             Namespace = t.Namespace
@@ -183,6 +208,7 @@ module TypeInfo =
             TypeAttributes = t.TypeAttributes
             Attributes = t.Attributes
             TypeDefHandle = t.TypeDefHandle
+            DeclaringType = t.DeclaringType
             Assembly = t.Assembly
             Generics = gen
             Events = t.Events
@@ -201,6 +227,7 @@ module TypeInfo =
         : TypeInfo<GenericParamFromMetadata, TypeDefn>
         =
         let typeDef = metadataReader.GetTypeDefinition typeHandle
+        let declaringType = typeDef.GetDeclaringType ()
         let methods = typeDef.GetMethods ()
 
         let methodImpls =
@@ -295,6 +322,7 @@ module TypeInfo =
             Generics = genericParams
             Events = events
             ImplementedInterfaces = interfaces
+            DeclaringType = declaringType
         }
 
     let isBaseType<'corelib>