Initobj (#114)

2025-10-06 06:28:39 +00:00 · 2025-08-24 20:23:50 +01:00
parent 622d0782ae
commit f9e186ba8f
13 changed files with 783 additions and 243 deletions
--- a/WoofWare.PawPrint.Domain/Assembly.fs
+++ b/WoofWare.PawPrint.Domain/Assembly.fs
@@ -423,8 +423,8 @@ module Assembly =
    let rec resolveTypeRef
        (assemblies : ImmutableDictionary<string, DumpedAssembly>)
        (referencedInAssembly : DumpedAssembly)
-        (target : TypeRef)
        (genericArgs : ImmutableArray<TypeDefn>)
+        (target : TypeRef)
        : TypeResolutionResult
        =
        match target.ResolutionScope with
@@ -495,7 +495,7 @@ module Assembly =
        | None ->

        match assy.TypeRef ns name with
-        | Some typeRef -> resolveTypeRef assemblies assy typeRef genericArgs
+        | Some typeRef -> resolveTypeRef assemblies assy genericArgs typeRef
        | None ->

        match assy.ExportedType (Some ns) name with
@@ -532,7 +532,7 @@ module DumpedAssembly =
            | Some (BaseTypeInfo.TypeRef r) ->
                let assy = loadedAssemblies.[source.FullName]
                // TODO: generics
-                match Assembly.resolveTypeRef loadedAssemblies assy assy.TypeRefs.[r] ImmutableArray.Empty with
+                match Assembly.resolveTypeRef loadedAssemblies assy ImmutableArray.Empty assy.TypeRefs.[r] with
                | TypeResolutionResult.FirstLoadAssy _ ->
                    failwith
                        "seems pretty unlikely that we could have constructed this object without loading its base type"
@@ -560,3 +560,35 @@ module DumpedAssembly =
            | None -> ResolvedBaseType.Object

        go source baseTypeInfo
+
+    let typeInfoToTypeDefn
+        (bct : BaseClassTypes<DumpedAssembly>)
+        (assemblies : ImmutableDictionary<string, DumpedAssembly>)
+        (ti : TypeInfo<TypeDefn, TypeDefn>)
+        =
+        ti
+        |> TypeInfo.toTypeDefn
+            bct
+            (fun n -> assemblies.[n.FullName])
+            _.Name
+            (fun x y -> x.TypeDefs.[y])
+            (fun x y ->
+                let r = x.TypeRefs.[y] |> Assembly.resolveTypeRef assemblies x ImmutableArray.Empty
+
+                match r with
+                | TypeResolutionResult.FirstLoadAssy assemblyReference -> failwith "todo"
+                | TypeResolutionResult.Resolved (dumpedAssembly, typeInfo) ->
+                    let result =
+                        typeInfo |> TypeInfo.mapGeneric (fun typeDef -> failwith "TODO: generics")
+
+                    dumpedAssembly, result
+            )
+
+    let typeInfoToTypeDefn'
+        (bct : BaseClassTypes<DumpedAssembly>)
+        (assemblies : ImmutableDictionary<string, DumpedAssembly>)
+        (ti : TypeInfo<GenericParamFromMetadata, TypeDefn>)
+        =
+        ti
+        |> TypeInfo.mapGeneric (fun (par, _) -> TypeDefn.GenericTypeParameter par.SequenceNumber)
+        |> typeInfoToTypeDefn bct assemblies
--- a/WoofWare.PawPrint.Domain/TypeConcretisation.fs
+++ b/WoofWare.PawPrint.Domain/TypeConcretisation.fs
@@ -420,7 +420,7 @@ module TypeConcretization =

        // First try to resolve without loading new assemblies
        let resolutionResult =
-            Assembly.resolveTypeRef ctx.LoadedAssemblies currentAssy typeRef ImmutableArray.Empty
+            Assembly.resolveTypeRef ctx.LoadedAssemblies currentAssy ImmutableArray.Empty typeRef

        match resolutionResult with
        | TypeResolutionResult.Resolved (targetAssy, typeInfo) -> (targetAssy, typeInfo), ctx
@@ -437,7 +437,7 @@ module TypeConcretization =

                // Now try to resolve again with the loaded assembly
                let resolutionResult2 =
-                    Assembly.resolveTypeRef newCtx.LoadedAssemblies currentAssy typeRef ImmutableArray.Empty
+                    Assembly.resolveTypeRef newCtx.LoadedAssemblies currentAssy ImmutableArray.Empty typeRef

                match resolutionResult2 with
                | TypeResolutionResult.Resolved (targetAssy, typeInfo) -> (targetAssy, typeInfo), newCtx
@@ -608,14 +608,14 @@ module TypeConcretization =

    /// Concretize a type in a specific generic context
    let rec concretizeType
-        (ctx : ConcretizationContext<'corelib>)
+        (ctx : ConcretizationContext<DumpedAssembly>)
        (loadAssembly :
            AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
        (assembly : AssemblyName)
        (typeGenerics : ImmutableArray<ConcreteTypeHandle>)
        (methodGenerics : ImmutableArray<ConcreteTypeHandle>)
        (typeDefn : TypeDefn)
-        : ConcreteTypeHandle * ConcretizationContext<'corelib>
+        : ConcreteTypeHandle * ConcretizationContext<DumpedAssembly>
        =

        let key = (assembly, typeDefn)
@@ -705,7 +705,7 @@ module TypeConcretization =
        | _ -> failwithf "TODO: Concretization of %A not implemented" typeDefn

    and private concretizeGenericInstantiation
-        (ctx : ConcretizationContext<'corelib>)
+        (ctx : ConcretizationContext<DumpedAssembly>)
        (loadAssembly :
            AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
        (assembly : AssemblyName)
@@ -713,7 +713,7 @@ module TypeConcretization =
        (methodGenerics : ImmutableArray<ConcreteTypeHandle>)
        (genericDef : TypeDefn)
        (args : ImmutableArray<TypeDefn>)
-        : ConcreteTypeHandle * ConcretizationContext<'corelib>
+        : ConcreteTypeHandle * ConcretizationContext<DumpedAssembly>
        =
        // First, concretize all type arguments
        let argHandles, ctxAfterArgs =
@@ -864,14 +864,14 @@ module Concretization =

    /// Helper to concretize an array of types
    let private concretizeTypeArray
-        (ctx : TypeConcretization.ConcretizationContext<'corelib>)
+        (ctx : TypeConcretization.ConcretizationContext<DumpedAssembly>)
        (loadAssembly :
            AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
        (assembly : AssemblyName)
        (typeArgs : ImmutableArray<ConcreteTypeHandle>)
        (methodArgs : ImmutableArray<ConcreteTypeHandle>)
        (types : ImmutableArray<TypeDefn>)
-        : ImmutableArray<ConcreteTypeHandle> * TypeConcretization.ConcretizationContext<'corelib>
+        : ImmutableArray<ConcreteTypeHandle> * TypeConcretization.ConcretizationContext<DumpedAssembly>
        =

        let handles = ImmutableArray.CreateBuilder types.Length
@@ -888,14 +888,14 @@ module Concretization =

    /// Helper to concretize a method signature
    let private concretizeMethodSignature
-        (ctx : TypeConcretization.ConcretizationContext<'corelib>)
+        (ctx : TypeConcretization.ConcretizationContext<DumpedAssembly>)
        (loadAssembly :
            AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
        (assembly : AssemblyName)
        (typeArgs : ImmutableArray<ConcreteTypeHandle>)
        (methodArgs : ImmutableArray<ConcreteTypeHandle>)
        (signature : TypeMethodSignature<TypeDefn>)
-        : TypeMethodSignature<ConcreteTypeHandle> * TypeConcretization.ConcretizationContext<'corelib>
+        : TypeMethodSignature<ConcreteTypeHandle> * TypeConcretization.ConcretizationContext<DumpedAssembly>
        =

        // Concretize return type
@@ -1157,8 +1157,7 @@ module Concretization =
                // Recursively convert generic arguments
                let genericArgs =
                    concreteType.Generics
-                    |> Seq.map (fun h -> concreteHandleToTypeDefn baseClassTypes h concreteTypes assemblies)
-                    |> ImmutableArray.CreateRange
+                    |> ImmutableArray.map (fun h -> concreteHandleToTypeDefn baseClassTypes h concreteTypes assemblies)

                let baseDef =
                    TypeDefn.FromDefinition (concreteType.Definition, concreteType.Assembly.FullName, signatureTypeKind)
--- a/WoofWare.PawPrint.Domain/TypeInfo.fs
+++ b/WoofWare.PawPrint.Domain/TypeInfo.fs
@@ -348,10 +348,10 @@ module TypeInfo =

    let rec resolveBaseType<'corelib, 'generic, 'field>
        (baseClassTypes : BaseClassTypes<'corelib>)
+        (sourceAssy : 'corelib)
        (getName : 'corelib -> AssemblyName)
        (getTypeDef : 'corelib -> TypeDefinitionHandle -> TypeInfo<'generic, 'field>)
-        (getTypeRef : 'corelib -> TypeReferenceHandle -> TypeInfo<'generic, 'field>)
-        (sourceAssembly : AssemblyName)
+        (getTypeRef : 'corelib -> TypeReferenceHandle -> 'corelib * TypeInfo<'generic, 'field>)
        (value : BaseTypeInfo option)
        : ResolvedBaseType
        =
@@ -361,40 +361,48 @@ module TypeInfo =

        match value with
        | BaseTypeInfo.TypeDef typeDefinitionHandle ->
-            match isBaseType baseClassTypes getName sourceAssembly typeDefinitionHandle with
+            match isBaseType baseClassTypes getName (getName sourceAssy) typeDefinitionHandle with
            | Some x -> x
            | None ->
                let baseType = getTypeDef baseClassTypes.Corelib typeDefinitionHandle
-                resolveBaseType baseClassTypes getName getTypeDef getTypeRef sourceAssembly baseType.BaseType
+                resolveBaseType baseClassTypes sourceAssy getName getTypeDef getTypeRef baseType.BaseType
        | BaseTypeInfo.TypeRef typeReferenceHandle ->
-            let typeRef = getTypeRef baseClassTypes.Corelib typeReferenceHandle
-            failwith $"{typeRef}"
+            let targetAssy, typeRef = getTypeRef sourceAssy typeReferenceHandle
+
+            match isBaseType baseClassTypes getName (getName targetAssy) typeRef.TypeDefHandle with
+            | Some x -> x
+            | None ->
+                let baseType = getTypeDef baseClassTypes.Corelib typeRef.TypeDefHandle
+                resolveBaseType baseClassTypes sourceAssy getName getTypeDef getTypeRef baseType.BaseType
        | BaseTypeInfo.TypeSpec typeSpecificationHandle -> failwith "todo"
        | BaseTypeInfo.ForeignAssemblyType (assemblyName, typeDefinitionHandle) ->
            resolveBaseType
                baseClassTypes
+                sourceAssy
                getName
                getTypeDef
                getTypeRef
-                assemblyName
                (Some (BaseTypeInfo.TypeDef typeDefinitionHandle))

    let toTypeDefn
        (baseClassTypes : BaseClassTypes<'corelib>)
+        (assemblies : AssemblyName -> 'corelib)
        (getName : 'corelib -> AssemblyName)
        (getTypeDef : 'corelib -> TypeDefinitionHandle -> TypeInfo<'generic, 'field>)
-        (getTypeRef : 'corelib -> TypeReferenceHandle -> TypeInfo<'generic, 'field>)
+        (getTypeRef : 'corelib -> TypeReferenceHandle -> 'corelib * TypeInfo<'generic, 'field>)
        (ty : TypeInfo<TypeDefn, TypeDefn>)
        : TypeDefn
        =
        let stk =
-            match resolveBaseType baseClassTypes getName getTypeDef getTypeRef ty.Assembly ty.BaseType with
+            match resolveBaseType baseClassTypes (assemblies ty.Assembly) getName getTypeDef getTypeRef ty.BaseType with
            | ResolvedBaseType.Enum
            | ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
            | ResolvedBaseType.Object
            | ResolvedBaseType.Delegate -> SignatureTypeKind.Class

        let defn =
+            // The only allowed construction of FromDefinition!
+            // All other constructions should use DumpedAssembly.typeInfoToTypeDefn.
            TypeDefn.FromDefinition (ComparableTypeDefinitionHandle.Make ty.TypeDefHandle, ty.Assembly.FullName, stk)

        if ty.Generics.IsEmpty then