patrick/WoofWare.PawPrint
1
0
Fork 0
mirror of https://github.com/Smaug123/WoofWare.PawPrint synced 2025-10-12 00:58:39 +00:00
Code Issues Packages Projects Releases Wiki Activity

Remove weird duplicate ConcreteType thing (#93)

Browse Source
This commit is contained in:
Patrick Stevens
2025-07-04 19:43:45 +01:00
committed by GitHub
parent de1eefb436
commit 56d1cf63d6
6 changed files with 43 additions and 100 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
WoofWare.PawPrint.Domain/TypeConcretisation.fs
View File

@@ -9,6 +9,12 @@ type ConcreteTypeHandle =
| Byref of ConcreteTypeHandle
| Pointer of ConcreteTypeHandle
override this.ToString () =
match this with
| ConcreteTypeHandle.Byref b -> "&" + b.ToString ()
| ConcreteTypeHandle.Concrete i -> i.ToString ()
| ConcreteTypeHandle.Pointer i -> "*" + i.ToString ()
type AllConcreteTypes =
{
Mapping : Map<int, ConcreteType<ConcreteTypeHandle>>

3
WoofWare.PawPrint/AbstractMachineDomain.fs
View File

@@ -14,6 +14,3 @@ type ManagedHeapAddress =
override this.ToString () : string =
match this with
| ManagedHeapAddress.ManagedHeapAddress i -> $"<object #%i{i}>"
[<Measure>]
type typeHandle

4
WoofWare.PawPrint/BasicCliType.fs
View File

@@ -63,7 +63,7 @@ type NativeIntSource =
| Verbatim of int64
| ManagedPointer of ManagedPointerSource
| FunctionPointer of MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle>
| TypeHandlePtr of int64<typeHandle>
| TypeHandlePtr of ConcreteTypeHandle
override this.ToString () : string =
match this with
@@ -71,7 +71,7 @@ type NativeIntSource =
| NativeIntSource.ManagedPointer ptr -> $"<managed pointer {ptr}>"
| NativeIntSource.FunctionPointer methodDefinition ->
$"<pointer to {methodDefinition.Name} in {methodDefinition.DeclaringType.Assembly.Name}>"
| NativeIntSource.TypeHandlePtr ptr -> $"<type ID %i{ptr}>"
| NativeIntSource.TypeHandlePtr ptr -> $"<type ID %O{ptr}>"
[<RequireQualifiedAccess>]
module NativeIntSource =

72
WoofWare.PawPrint/IlMachineState.fs
View File

@@ -1,6 +1,5 @@
namespace WoofWare.PawPrint
open System
open System.Collections.Immutable
open System.IO
open System.Reflection
@@ -1362,9 +1361,9 @@ module IlMachineState =
/// Returns the type handle and an allocated System.RuntimeType.
let getOrAllocateType<'corelib>
(baseClassTypes : BaseClassTypes<'corelib>)
(defn : CanonicalTypeIdentity)
(defn : ConcreteTypeHandle)
(state : IlMachineState)
: (int64<typeHandle> * ManagedHeapAddress) * IlMachineState
: ManagedHeapAddress * IlMachineState
=
let result, reg, state =
TypeHandleRegistry.getOrAllocate
@@ -1403,70 +1402,3 @@ module IlMachineState =
match v.TryGetValue field with
| false, _ -> None
| true, v -> Some v
let rec canonicaliseTypeReference
(assy : AssemblyName)
(ty : TypeReferenceHandle)
(state : IlMachineState)
: Result<CanonicalTypeIdentity, AssemblyName>
=
match state.LoadedAssembly assy with
| None -> Error assy
| Some assy ->
match assy.TypeRefs.TryGetValue ty with
| false, _ -> failwith $"could not find type reference in assembly %s{assy.Name.FullName}"
| true, v ->
match v.ResolutionScope with
| TypeRefResolutionScope.Assembly newAssy ->
let newAssy = assy.AssemblyReferences.[newAssy].Name
match state.LoadedAssembly newAssy with
| None -> Error newAssy
| Some newAssy ->
{
AssemblyFullName = newAssy.Name.FullName
FullyQualifiedTypeName = $"%s{v.Namespace}.%s{v.Name}"
// TODO: I think TypeRef can't have generics?
Generics = []
}
|> Ok
| TypeRefResolutionScope.ModuleRef _ -> failwith "todo"
| TypeRefResolutionScope.TypeRef r ->
if (r.GetHashCode ()) <> (ty.GetHashCode ()) then
failwith "apparently this doesn't do what I thought"
{
AssemblyFullName = assy.Name.FullName
FullyQualifiedTypeName = $"%s{v.Namespace}.%s{v.Name}"
Generics = []
}
|> Ok
let canonicaliseTypeDef
(assy : AssemblyName)
(ty : TypeDefinitionHandle)
(typeGenerics : CanonicalTypeIdentity list)
(methodGenerics : CanonicalTypeIdentity list)
(state : IlMachineState)
: Result<CanonicalTypeIdentity, AssemblyName>
=
match state.LoadedAssembly assy with
| None -> Error assy
| Some assy ->
match assy.TypeDefs.TryGetValue ty with
| false, _ -> failwith $"could not find type def in assembly %s{assy.Name.FullName}"
| true, v ->
if not (typeGenerics.IsEmpty && methodGenerics.IsEmpty) then
failwith "TODO: generics"
{
AssemblyFullName = assy.Name.FullName
FullyQualifiedTypeName = $"%s{v.Namespace}.%s{v.Name}"
Generics = []
}
|> Ok

28
WoofWare.PawPrint/TypeHandleRegistry.fs
View File

@@ -1,18 +1,10 @@
namespace WoofWare.PawPrint
type CanonicalTypeIdentity =
{
AssemblyFullName : string
FullyQualifiedTypeName : string
Generics : CanonicalTypeIdentity list
}
type TypeHandleRegistry =
private
{
TypeHandleToType : Map<int64<typeHandle>, CanonicalTypeIdentity>
TypeToHandle : Map<CanonicalTypeIdentity, int64<typeHandle> * ManagedHeapAddress>
NextHandle : int64<typeHandle>
TypeHandleToType : Map<ManagedHeapAddress, ConcreteTypeHandle>
TypeToHandle : Map<ConcreteTypeHandle, ManagedHeapAddress>
}
[<RequireQualifiedAccess>]
@@ -21,23 +13,20 @@ module TypeHandleRegistry =
{
TypeHandleToType = Map.empty
TypeToHandle = Map.empty
NextHandle = 1L<typeHandle>
}
/// Returns an allocated System.RuntimeType as well.
let getOrAllocate
(allocState : 'allocState)
(allocate : (string * CliType) list -> 'allocState -> ManagedHeapAddress * 'allocState)
(def : CanonicalTypeIdentity)
(def : ConcreteTypeHandle)
(reg : TypeHandleRegistry)
: (int64<typeHandle> * ManagedHeapAddress) * TypeHandleRegistry * 'allocState
: ManagedHeapAddress * TypeHandleRegistry * 'allocState
=
match Map.tryFind def reg.TypeToHandle with
| Some v -> v, reg, allocState
| None ->
let handle = reg.NextHandle
// Here follows the class System.RuntimeType, which is an internal class type with a constructor
// whose only purpose is to throw.
let fields =
@@ -46,7 +35,7 @@ module TypeHandleRegistry =
"m_keepalive", CliType.ObjectRef None
// TODO: this is actually a System.IntPtr https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/coreclr/nativeaot/Runtime.Base/src/System/Primitives.cs#L339
"m_cache", CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.Verbatim 0L))
"m_handle", CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.TypeHandlePtr handle))
"m_handle", CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.TypeHandlePtr def))
// This is the const -1, apparently?!
// https://github.com/dotnet/runtime/blob/f0168ee80ba9aca18a7e7140b2bb436defda623c/src/coreclr/System.Private.CoreLib/src/System/RuntimeType.CoreCLR.cs#L2496
"GenericParameterCountAny", CliType.Numeric (CliNumericType.Int32 -1)
@@ -56,9 +45,8 @@ module TypeHandleRegistry =
let reg =
{
NextHandle = handle + 1L<typeHandle>
TypeHandleToType = reg.TypeHandleToType |> Map.add handle def
TypeToHandle = reg.TypeToHandle |> Map.add def (handle, alloc)
TypeHandleToType = reg.TypeHandleToType |> Map.add alloc def
TypeToHandle = reg.TypeToHandle |> Map.add def alloc
}
(handle, alloc), reg, state
alloc, reg, state

30
WoofWare.PawPrint/UnaryMetadataIlOp.fs
View File

@@ -1098,12 +1098,32 @@ module internal UnaryMetadataIlOp =
if not (methodGenerics.IsEmpty && typeGenerics.IsEmpty) then
failwith "TODO: generics"
let handle =
match IlMachineState.canonicaliseTypeDef (state.ActiveAssembly(thread).Name) h [] [] state with
| Error e -> failwith $"TODO: somehow need to load {e.FullName} first"
| Ok h -> h
let state, typeDefn = lookupTypeDefn baseClassTypes state activeAssy h
let (_, alloc), state = IlMachineState.getOrAllocateType baseClassTypes handle state
let ctx =
{
TypeConcretization.ConcretizationContext.InProgress = ImmutableDictionary.Empty
TypeConcretization.ConcretizationContext.ConcreteTypes = state.ConcreteTypes
TypeConcretization.ConcretizationContext.LoadedAssemblies = state._LoadedAssemblies
TypeConcretization.ConcretizationContext.BaseTypes = baseClassTypes
}
let handle, newCtx =
TypeConcretization.concretizeType
ctx
(fun _ _ -> failwith "getAssembly not needed for type def concretization")
activeAssy.Name
typeGenerics
methodGenerics
typeDefn
let state =
{ state with
_LoadedAssemblies = newCtx.LoadedAssemblies
ConcreteTypes = newCtx.ConcreteTypes
}
let alloc, state = IlMachineState.getOrAllocateType baseClassTypes handle state
let vt =
{