Progress towards the GenericEdgeCases test (#96)

WoofWare.PawPrint.Domain/Assembly.fs

@@ -565,6 +565,7 @@ module DumpedAssembly =
         (bct : BaseClassTypes<DumpedAssembly>)
         (assemblies : ImmutableDictionary<string, DumpedAssembly>)
         (ti : TypeInfo<TypeDefn, TypeDefn>)
+        : TypeDefn
         =
         ti
         |> TypeInfo.toTypeDefn

WoofWare.PawPrint.Domain/TypeConcretisation.fs

@@ -183,6 +183,24 @@ module ConcreteActivePatterns =
             | _ -> None
         | _ -> None
 
+    let (|ConcreteGenericArray|_|)
+        (concreteTypes : AllConcreteTypes)
+        (eltType : ConcreteTypeHandle)
+        (handle : ConcreteTypeHandle)
+        =
+        match handle with
+        | ConcreteTypeHandle.Concrete id ->
+            match concreteTypes.Mapping |> Map.tryFind id with
+            | Some ct when
+                ct.Assembly.Name = "System.Private.CoreLib"
+                && ct.Namespace = "System"
+                && ct.Name = "Array"
+                && Seq.tryExactlyOne ct.Generics = Some eltType
+                ->
+                Some ()
+            | _ -> None
+        | _ -> None
+
     let (|ConcreteObj|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option =
         match handle with
         | ConcreteTypeHandle.Concrete id ->
@@ -302,6 +320,23 @@ module ConcreteActivePatterns =
             | None -> None
         | _ -> None
 
+    let (|ConcreteUInt32|_|) (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 = "UInt32"
+                    && ct.Generics.IsEmpty
+                then
+                    Some ()
+                else
+                    None
+            | None -> None
+        | _ -> None
+
     let (|ConcreteSingle|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option =
         match handle with
         | ConcreteTypeHandle.Concrete id ->
@@ -331,6 +366,13 @@ module ConcreteActivePatterns =
         | ConcreteTypeHandle.Pointer inner -> Some inner
         | _ -> None
 
+type IAssemblyLoad =
+    abstract LoadAssembly :
+        loadedAssemblies : ImmutableDictionary<string, DumpedAssembly> ->
+        referencedIn : AssemblyName ->
+        handle : AssemblyReferenceHandle ->
+            ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly
+
 [<RequireQualifiedAccess>]
 module TypeConcretization =
 
@@ -406,8 +448,7 @@ module TypeConcretization =
 
     // Helper function for assembly loading with retry pattern
     let private loadAssemblyAndResolveTypeRef
-        (loadAssembly :
-            AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
+        (loadAssembly : IAssemblyLoad)
         (ctx : ConcretizationContext<'corelib>)
         (currentAssembly : AssemblyName)
         (typeRef : TypeRef)
@@ -428,7 +469,8 @@ module TypeConcretization =
             // Need to load the assembly
             match typeRef.ResolutionScope with
             | TypeRefResolutionScope.Assembly assyRef ->
-                let newAssemblies, _ = loadAssembly currentAssembly assyRef
+                let newAssemblies, _ =
+                    loadAssembly.LoadAssembly ctx.LoadedAssemblies currentAssembly assyRef
 
                 let newCtx =
                     { ctx with
@@ -584,8 +626,7 @@ module TypeConcretization =
                 ImmutableArray.Empty // No generic parameters
 
     let private concretizeTypeReference
-        (loadAssembly :
-            AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
+        (loadAssembly : IAssemblyLoad)
         (ctx : ConcretizationContext<'corelib>)
         (currentAssembly : AssemblyName)
         (typeRef : TypeRef)
@@ -609,8 +650,7 @@ module TypeConcretization =
     /// Concretize a type in a specific generic context
     let rec concretizeType
         (ctx : ConcretizationContext<DumpedAssembly>)
-        (loadAssembly :
-            AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
+        (loadAssembly : IAssemblyLoad)
         (assembly : AssemblyName)
         (typeGenerics : ImmutableArray<ConcreteTypeHandle>)
         (methodGenerics : ImmutableArray<ConcreteTypeHandle>)
@@ -706,8 +746,7 @@ module TypeConcretization =
 
     and private concretizeGenericInstantiation
         (ctx : ConcretizationContext<DumpedAssembly>)
-        (loadAssembly :
-            AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
+        (loadAssembly : IAssemblyLoad)
         (assembly : AssemblyName)
         (typeGenerics : ImmutableArray<ConcreteTypeHandle>)
         (methodGenerics : ImmutableArray<ConcreteTypeHandle>)
@@ -786,7 +825,8 @@ module TypeConcretization =
 
                     | false, _ ->
                         // Need to load the assembly
-                        let newAssemblies, loadedAssy = loadAssembly assembly assyRef
+                        let newAssemblies, loadedAssy =
+                            loadAssembly.LoadAssembly ctx.LoadedAssemblies assembly assyRef
 
                         let ctxWithNewAssy =
                             { ctxAfterArgs with
@@ -865,8 +905,7 @@ module Concretization =
     /// Helper to concretize an array of types
     let private concretizeTypeArray
         (ctx : TypeConcretization.ConcretizationContext<DumpedAssembly>)
-        (loadAssembly :
-            AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
+        (loadAssembly : IAssemblyLoad)
         (assembly : AssemblyName)
         (typeArgs : ImmutableArray<ConcreteTypeHandle>)
         (methodArgs : ImmutableArray<ConcreteTypeHandle>)
@@ -889,8 +928,7 @@ module Concretization =
     /// Helper to concretize a method signature
     let private concretizeMethodSignature
         (ctx : TypeConcretization.ConcretizationContext<DumpedAssembly>)
-        (loadAssembly :
-            AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
+        (loadAssembly : IAssemblyLoad)
         (assembly : AssemblyName)
         (typeArgs : ImmutableArray<ConcreteTypeHandle>)
         (methodArgs : ImmutableArray<ConcreteTypeHandle>)
@@ -926,8 +964,7 @@ module Concretization =
 
     /// Helper to ensure base type assembly is loaded
     let rec private ensureBaseTypeAssembliesLoaded
-        (loadAssembly :
-            AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
+        (loadAssembly : IAssemblyLoad)
         (assemblies : ImmutableDictionary<string, DumpedAssembly>)
         (assyName : AssemblyName)
         (baseTypeInfo : BaseTypeInfo option)
@@ -947,7 +984,7 @@ module Concretization =
                 | true, _ -> assemblies
                 | false, _ ->
                     // Need to load the assembly - pass the assembly that contains the reference
-                    let newAssemblies, _ = loadAssembly assy.Name assyRef
+                    let newAssemblies, _ = loadAssembly.LoadAssembly assemblies assy.Name assyRef
                     newAssemblies
             | _ -> assemblies
         | Some (BaseTypeInfo.TypeDef _)
@@ -957,8 +994,7 @@ module Concretization =
     /// Concretize a method's signature and body
     let concretizeMethod
         (ctx : AllConcreteTypes)
-        (loadAssembly :
-            AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
+        (loadAssembly : IAssemblyLoad)
         (assemblies : ImmutableDictionary<string, DumpedAssembly>)
         (baseTypes : BaseClassTypes<DumpedAssembly>)
         (method : WoofWare.PawPrint.MethodInfo<'ty, GenericParamFromMetadata, TypeDefn>)