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

Plumb generic metadata through (#107)

Browse Source
This commit is contained in:
Patrick Stevens
2025-08-23 15:18:05 +01:00
committed by GitHub
parent 3bdfeaf8a1
commit 92f22cff42
15 changed files with 228 additions and 220 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
WoofWare.PawPrint.Domain/Assembly.fs
View File

@@ -45,10 +45,7 @@ type DumpedAssembly =
/// Dictionary of all type definitions in this assembly, keyed by their handle.
/// </summary>
TypeDefs :
IReadOnlyDictionary<
TypeDefinitionHandle,
WoofWare.PawPrint.TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
>
IReadOnlyDictionary<TypeDefinitionHandle, WoofWare.PawPrint.TypeInfo<GenericParamFromMetadata, TypeDefn>>
/// <summary>
/// Dictionary of all type references in this assembly, keyed by their handle.
@@ -67,7 +64,7 @@ type DumpedAssembly =
Methods :
IReadOnlyDictionary<
MethodDefinitionHandle,
WoofWare.PawPrint.MethodInfo<FakeUnit, WoofWare.PawPrint.GenericParameter, TypeDefn>
WoofWare.PawPrint.MethodInfo<GenericParamFromMetadata, GenericParamFromMetadata, TypeDefn>
>
/// <summary>
@@ -78,7 +75,8 @@ type DumpedAssembly =
/// <summary>
/// Dictionary of all field definitions in this assembly, keyed by their handle.
/// </summary>
Fields : IReadOnlyDictionary<FieldDefinitionHandle, WoofWare.PawPrint.FieldInfo<FakeUnit, TypeDefn>>
Fields :
IReadOnlyDictionary<FieldDefinitionHandle, WoofWare.PawPrint.FieldInfo<GenericParamFromMetadata, TypeDefn>>
/// <summary>
/// The entry point method of the assembly, if one exists.
@@ -146,10 +144,7 @@ type DumpedAssembly =
/// Internal lookup for type definitions by namespace and name.
/// </summary>
_TypeDefsLookup :
ImmutableDictionary<
string * string,
WoofWare.PawPrint.TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
>
ImmutableDictionary<string * string, WoofWare.PawPrint.TypeInfo<GenericParamFromMetadata, TypeDefn>>
}
static member internal BuildExportedTypesLookup
@@ -205,7 +200,7 @@ type DumpedAssembly =
static member internal BuildTypeDefsLookup
(logger : ILogger)
(name : AssemblyName)
(typeDefs : WoofWare.PawPrint.TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn> seq)
(typeDefs : WoofWare.PawPrint.TypeInfo<GenericParamFromMetadata, TypeDefn> seq)
=
let result = ImmutableDictionary.CreateBuilder ()
let keys = HashSet ()
@@ -236,7 +231,7 @@ type DumpedAssembly =
member this.TypeDef
(``namespace`` : string)
(name : string)
: WoofWare.PawPrint.TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn> option
: WoofWare.PawPrint.TypeInfo<GenericParamFromMetadata, TypeDefn> option
=
match this._TypeDefsLookup.TryGetValue ((``namespace``, name)) with
| false, _ -> None
@@ -467,7 +462,9 @@ module Assembly =
match targetType with
| [ t ] ->
let t = t |> TypeInfo.mapGeneric (fun _ param -> genericArgs.[param.SequenceNumber])
let t =
t
|> TypeInfo.mapGeneric (fun _ (param, md) -> genericArgs.[param.SequenceNumber])
TypeResolutionResult.Resolved (assy, t)
| _ :: _ :: _ -> failwith $"Multiple matching type definitions! {nsPath} {target.Name}"
@@ -493,7 +490,7 @@ module Assembly =
| Some typeDef ->
let typeDef =
typeDef
|> TypeInfo.mapGeneric (fun _ param -> genericArgs.[param.SequenceNumber])
|> TypeInfo.mapGeneric (fun _ (param, md) -> genericArgs.[param.SequenceNumber])
TypeResolutionResult.Resolved (assy, typeDef)
| None ->

64
WoofWare.PawPrint.Domain/ConcreteType.fs
View File

@@ -1,6 +1,5 @@
namespace WoofWare.PawPrint
open System
open System.Collections.Immutable
open System.Reflection
open System.Reflection.Metadata
@@ -17,8 +16,8 @@ module FakeUnit =
/// A type which has been concretised, runtime-representable, etc.
[<CustomEquality>]
[<CustomComparison>]
type ConcreteType<'typeGeneric when 'typeGeneric : comparison and 'typeGeneric :> IComparable<'typeGeneric>> =
[<NoComparison>]
type ConcreteType<'typeGeneric> =
private
{
/// Do not use this, because it's intended to be private; use the accessor `.Assembly : AssemblyName`
@@ -31,12 +30,12 @@ type ConcreteType<'typeGeneric when 'typeGeneric : comparison and 'typeGeneric :
/// Do not use this, because it's intended to be private; use the accessor `.Namespace` instead.
_Namespace : string
/// Do not use this, because it's intended to be private; use the accessor `.Generics` instead.
_Generics : 'typeGeneric ImmutableArray
_Generics : ImmutableArray<'typeGeneric>
}
member this.Assembly : AssemblyName = this._AssemblyName
member this.Definition : ComparableTypeDefinitionHandle = this._Definition
member this.Generics : 'typeGeneric ImmutableArray = this._Generics
member this.Generics : ImmutableArray<'typeGeneric> = this._Generics
member this.Name = this._Name
member this.Namespace = this._Namespace
@@ -51,71 +50,26 @@ type ConcreteType<'typeGeneric when 'typeGeneric : comparison and 'typeGeneric :
override this.GetHashCode () : int =
hash (this._AssemblyName.FullName, this._Definition, this._Generics)
interface IComparable<ConcreteType<'typeGeneric>> with
member this.CompareTo (other : ConcreteType<'typeGeneric>) : int =
let comp = this._AssemblyName.FullName.CompareTo other._AssemblyName.FullName
if comp <> 0 then
comp
else
let comp =
(this._Definition :> IComparable<ComparableTypeDefinitionHandle>).CompareTo other._Definition
if comp <> 0 then
comp
else
let thisGen = this._Generics |> Seq.toList :> IComparable<'typeGeneric list>
thisGen.CompareTo (other._Generics |> Seq.toList)
interface IComparable with
member this.CompareTo other =
match other with
| :? ConcreteType<'typeGeneric> as other ->
(this :> IComparable<ConcreteType<'typeGeneric>>).CompareTo other
| _ -> failwith "bad comparison"
[<RequireQualifiedAccess>]
module ConcreteType =
let make
(assemblyName : AssemblyName)
(defn : TypeDefinitionHandle)
(ns : string)
(name : string)
(defn : TypeDefinitionHandle)
(generics : TypeDefn ImmutableArray)
: ConcreteType<TypeDefn>
(genericParam : ImmutableArray<GenericParamFromMetadata>)
: ConcreteType<GenericParamFromMetadata>
=
{
_AssemblyName = assemblyName
_Definition = ComparableTypeDefinitionHandle.Make defn
_Name = name
_Namespace = ns
_Generics = generics
_Generics = genericParam
}
let make'
(assemblyName : AssemblyName)
(defn : TypeDefinitionHandle)
(ns : string)
(name : string)
(genericParamCount : int)
: ConcreteType<FakeUnit>
=
{
_AssemblyName = assemblyName
_Definition = ComparableTypeDefinitionHandle.Make defn
_Name = name
_Namespace = ns
_Generics = Seq.replicate genericParamCount FakeUnit.FakeUnit |> ImmutableArray.CreateRange
}
let mapGeneric<'a, 'b
when 'a : comparison and 'a :> IComparable<'a> and 'b : equality and 'b : comparison and 'b :> IComparable<'b>>
(f : int -> 'a -> 'b)
(x : ConcreteType<'a>)
: ConcreteType<'b>
=
let mapGeneric<'a, 'b> (f : int -> 'a -> 'b) (x : ConcreteType<'a>) : ConcreteType<'b> =
let generics = x._Generics |> Seq.mapi f |> ImmutableArray.CreateRange
{

21
WoofWare.PawPrint.Domain/FieldInfo.fs
View File

@@ -1,6 +1,5 @@
namespace WoofWare.PawPrint
open System
open System.Reflection
open System.Reflection.Metadata
@@ -8,8 +7,7 @@ open System.Reflection.Metadata
/// Represents detailed information about a field in a .NET assembly.
/// This is a strongly-typed representation of FieldDefinition from System.Reflection.Metadata.
/// </summary>
type FieldInfo<'typeGeneric, 'fieldGeneric when 'typeGeneric : comparison and 'typeGeneric :> IComparable<'typeGeneric>>
=
type FieldInfo<'typeGeneric, 'fieldGeneric> =
{
/// <summary>
/// The metadata token handle that uniquely identifies this field in the assembly.
@@ -48,18 +46,22 @@ module FieldInfo =
(assembly : AssemblyName)
(handle : FieldDefinitionHandle)
(def : FieldDefinition)
: FieldInfo<FakeUnit, TypeDefn>
: FieldInfo<GenericParamFromMetadata, TypeDefn>
=
let name = mr.GetString def.Name
let fieldSig = def.DecodeSignature (TypeDefn.typeProvider assembly, ())
let declaringType = def.GetDeclaringType ()
let typeGenerics = mr.GetTypeDefinition(declaringType).GetGenericParameters().Count
let typeGenerics =
mr.GetTypeDefinition(declaringType).GetGenericParameters ()
|> GenericParameter.readAll mr
let decType = mr.GetTypeDefinition declaringType
let declaringTypeNamespace = mr.GetString decType.Namespace
let declaringTypeName = mr.GetString decType.Name
let declaringType =
ConcreteType.make' assembly declaringType declaringTypeNamespace declaringTypeName typeGenerics
ConcreteType.make assembly declaringType declaringTypeNamespace declaringTypeName typeGenerics
{
Name = name
@@ -69,12 +71,7 @@ module FieldInfo =
Attributes = def.Attributes
}
let mapTypeGenerics<'a, 'b, 'field
when 'a :> IComparable<'a> and 'a : comparison and 'b :> IComparable<'b> and 'b : comparison>
(f : int -> 'a -> 'b)
(input : FieldInfo<'a, 'field>)
: FieldInfo<'b, 'field>
=
let mapTypeGenerics<'a, 'b, 'field> (f : int -> 'a -> 'b) (input : FieldInfo<'a, 'field>) : FieldInfo<'b, 'field> =
let declaringType = input.DeclaringType |> ConcreteType.mapGeneric f
{

85
WoofWare.PawPrint.Domain/GenericParameter.fs Normal file
View File

@@ -0,0 +1,85 @@
namespace WoofWare.PawPrint
open System.Collections.Immutable
open System.Reflection
open System.Reflection.Metadata
type GenericVariance =
| Covariant
| Contravariant
type GenericConstraint =
| Reference
| NonNullableValue
type GenericParamMetadata =
{
Variance : GenericVariance option
Constraint : GenericConstraint option
RequiresParameterlessConstructor : bool
}
/// <summary>
/// Represents a generic type or method parameter definition.
/// Corresponds to GenericParameter in System.Reflection.Metadata.
/// </summary>
type GenericParameter =
{
/// <summary>The name of the generic parameter (e.g., 'T', 'TKey', etc.).</summary>
Name : string
/// <summary>
/// The zero-based index of the generic parameter in the generic parameter list.
/// For example, in Dictionary&lt;TKey, TValue&rt;, TKey has index 0 and TValue has index 1.
/// </summary>
SequenceNumber : int
}
type GenericParamFromMetadata = GenericParameter * GenericParamMetadata
[<RequireQualifiedAccess>]
module GenericParameter =
let readAll
(metadata : MetadataReader)
(param : GenericParameterHandleCollection)
: GenericParamFromMetadata ImmutableArray
=
param
|> Seq.map (fun param ->
let param = metadata.GetGenericParameter param
let requiresParamlessCons =
param.Attributes.HasFlag GenericParameterAttributes.DefaultConstructorConstraint
let constr =
if param.Attributes.HasFlag GenericParameterAttributes.NotNullableValueTypeConstraint then
Some GenericConstraint.NonNullableValue
elif param.Attributes.HasFlag GenericParameterAttributes.ReferenceTypeConstraint then
Some GenericConstraint.Reference
else
None
let variance =
if param.Attributes.HasFlag GenericParameterAttributes.Contravariant then
Some GenericVariance.Contravariant
elif param.Attributes.HasFlag GenericParameterAttributes.Covariant then
Some GenericVariance.Covariant
else
None
let md =
{
Variance = variance
Constraint = constr
RequiresParameterlessConstructor = requiresParamlessCons
}
let p =
{
Name = metadata.GetString param.Name
SequenceNumber = param.Index
}
p, md
)
|> ImmutableArray.CreateRange

22
WoofWare.PawPrint.Domain/ImmutableArray.fs Normal file
View File

@@ -0,0 +1,22 @@
namespace WoofWare.PawPrint
open System.Collections.Immutable
[<RequireQualifiedAccess>]
module internal ImmutableArray =
let inline map ([<InlineIfLambda>] f : 'a -> 'b) (arr : ImmutableArray<'a>) : ImmutableArray<'b> =
let b = ImmutableArray.CreateBuilder ()
for i in arr do
b.Add (f i)
b.ToImmutable ()
let inline mapi ([<InlineIfLambda>] f : int -> 'a -> 'b) (arr : ImmutableArray<'a>) : ImmutableArray<'b> =
let b = ImmutableArray.CreateBuilder ()
for i = 0 to arr.Length - 1 do
b.Add (f i arr.[i])
b.ToImmutable ()

91
WoofWare.PawPrint.Domain/MethodInfo.fs
View File

@@ -52,74 +52,6 @@ module Parameter =
result.ToImmutable ()
type GenericVariance =
| Covariant
| Contravariant
type GenericConstraint =
| Reference
| NonNullableValue
/// <summary>
/// Represents a generic type or method parameter definition.
/// Corresponds to GenericParameter in System.Reflection.Metadata.
/// </summary>
type GenericParameter =
{
/// <summary>The name of the generic parameter (e.g., 'T', 'TKey', etc.).</summary>
Name : string
/// <summary>
/// The zero-based index of the generic parameter in the generic parameter list.
/// For example, in Dictionary&lt;TKey, TValue&rt;, TKey has index 0 and TValue has index 1.
/// </summary>
SequenceNumber : int
Variance : GenericVariance option
Constraint : GenericConstraint option
RequiresParameterlessConstructor : bool
}
[<RequireQualifiedAccess>]
module GenericParameter =
let readAll
(metadata : MetadataReader)
(param : GenericParameterHandleCollection)
: GenericParameter ImmutableArray
=
param
|> Seq.map (fun param ->
let param = metadata.GetGenericParameter param
let requiresParamlessCons =
param.Attributes.HasFlag GenericParameterAttributes.DefaultConstructorConstraint
let constr =
if param.Attributes.HasFlag GenericParameterAttributes.NotNullableValueTypeConstraint then
Some GenericConstraint.NonNullableValue
elif param.Attributes.HasFlag GenericParameterAttributes.ReferenceTypeConstraint then
Some GenericConstraint.Reference
else
None
let variance =
if param.Attributes.HasFlag GenericParameterAttributes.Contravariant then
Some GenericVariance.Contravariant
elif param.Attributes.HasFlag GenericParameterAttributes.Covariant then
Some GenericVariance.Covariant
else
None
{
Name = metadata.GetString param.Name
SequenceNumber = param.Index
Variance = variance
Constraint = constr
RequiresParameterlessConstructor = requiresParamlessCons
}
)
|> ImmutableArray.CreateRange
type ExceptionOffset =
{
TryLength : int
@@ -202,8 +134,7 @@ module MethodInstructions =
/// Represents detailed information about a method in a .NET assembly.
/// This is a strongly-typed representation of MethodDefinition from System.Reflection.Metadata.
/// </summary>
type MethodInfo<'typeGenerics, 'methodGenerics, 'methodVars
when 'typeGenerics :> IComparable<'typeGenerics> and 'typeGenerics : comparison> =
type MethodInfo<'typeGenerics, 'methodGenerics, 'methodVars> =
{
/// <summary>
/// The type that declares this method, along with its assembly information.
@@ -301,14 +232,13 @@ module MethodInfo =
| con -> failwith $"TODO: {con}"
)
let mapTypeGenerics<'a, 'b, 'methodGen, 'vars
when 'a :> IComparable<'a> and 'a : comparison and 'b : comparison and 'b :> IComparable<'b>>
(f : int -> 'a -> 'b)
let mapTypeGenerics<'a, 'b, 'methodGen, 'vars>
(f : 'a -> 'b)
(m : MethodInfo<'a, 'methodGen, 'vars>)
: MethodInfo<'b, 'methodGen, 'vars>
=
{
DeclaringType = m.DeclaringType |> ConcreteType.mapGeneric f
DeclaringType = m.DeclaringType |> ConcreteType.mapGeneric (fun _ -> f)
Handle = m.Handle
Name = m.Name
Instructions = m.Instructions
@@ -322,18 +252,20 @@ module MethodInfo =
IsStatic = m.IsStatic
}
let mapMethodGenerics<'a, 'b, 'vars, 'typeGen when 'typeGen :> IComparable<'typeGen> and 'typeGen : comparison>
let mapMethodGenerics<'a, 'b, 'vars, 'typeGen>
(f : int -> 'a -> 'b)
(m : MethodInfo<'typeGen, 'a, 'vars>)
: MethodInfo<'typeGen, 'b, 'vars>
=
let generics = m.Generics |> Seq.mapi f |> ImmutableArray.CreateRange
{
DeclaringType = m.DeclaringType
Handle = m.Handle
Name = m.Name
Instructions = m.Instructions
Parameters = m.Parameters
Generics = m.Generics |> Seq.mapi f |> ImmutableArray.CreateRange
Generics = generics
Signature = m.Signature
RawSignature = m.RawSignature
CustomAttributes = m.CustomAttributes
@@ -710,7 +642,7 @@ module MethodInfo =
(peReader : PEReader)
(metadataReader : MetadataReader)
(methodHandle : MethodDefinitionHandle)
: MethodInfo<FakeUnit, GenericParameter, TypeDefn> option
: MethodInfo<GenericParamFromMetadata, GenericParamFromMetadata, TypeDefn> option
=
let logger = loggerFactory.CreateLogger "MethodInfo"
let assemblyName = metadataReader.GetAssemblyDefinition().GetAssemblyName ()
@@ -751,7 +683,8 @@ module MethodInfo =
let declaringTypeName = metadataReader.GetString declaringDefn.Name
let declaringTypeGenericParams =
metadataReader.GetTypeDefinition(declaringType).GetGenericParameters().Count
metadataReader.GetTypeDefinition(declaringType).GetGenericParameters ()
|> GenericParameter.readAll metadataReader
let attrs =
let result = ImmutableArray.CreateBuilder ()
@@ -772,7 +705,7 @@ module MethodInfo =
GenericParameter.readAll metadataReader (methodDef.GetGenericParameters ())
let declaringType =
ConcreteType.make'
ConcreteType.make
assemblyName
declaringType
declaringTypeNamespace

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

@@ -910,7 +910,7 @@ module Concretization =
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
(baseTypes : BaseClassTypes<DumpedAssembly>)
(method : WoofWare.PawPrint.MethodInfo<TypeDefn, WoofWare.PawPrint.GenericParameter, TypeDefn>)
(method : WoofWare.PawPrint.MethodInfo<TypeDefn, GenericParamFromMetadata, TypeDefn>)
(typeArgs : ConcreteTypeHandle ImmutableArray)
(methodArgs : ConcreteTypeHandle ImmutableArray)
: WoofWare.PawPrint.MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle> *

62
WoofWare.PawPrint.Domain/TypeInfo.fs
View File

@@ -43,7 +43,7 @@ type TypeInfo<'generic, 'fieldGeneric> =
/// <summary>
/// All methods defined within this type.
/// </summary>
Methods : WoofWare.PawPrint.MethodInfo<FakeUnit, WoofWare.PawPrint.GenericParameter, TypeDefn> list
Methods : WoofWare.PawPrint.MethodInfo<GenericParamFromMetadata, GenericParamFromMetadata, TypeDefn> list
/// <summary>
/// Method implementation mappings for this type, often used for interface implementations
@@ -54,7 +54,7 @@ type TypeInfo<'generic, 'fieldGeneric> =
/// <summary>
/// Fields defined in this type.
/// </summary>
Fields : WoofWare.PawPrint.FieldInfo<FakeUnit, 'fieldGeneric> list
Fields : WoofWare.PawPrint.FieldInfo<GenericParamFromMetadata, 'fieldGeneric> list
/// <summary>
/// The base type that this type inherits from, or None for types that don't have a base type
@@ -140,34 +140,34 @@ module TypeInfoCrate =
type BaseClassTypes<'corelib> =
{
Corelib : 'corelib
String : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
Boolean : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
Char : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
SByte : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
Byte : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
Int16 : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
UInt16 : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
Int32 : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
UInt32 : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
Int64 : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
UInt64 : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
Single : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
Double : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
Array : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
Enum : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
ValueType : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
DelegateType : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
Object : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
RuntimeMethodHandle : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
RuntimeFieldHandle : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
RuntimeTypeHandle : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
RuntimeFieldInfoStub : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
RuntimeFieldHandleInternal : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
RuntimeType : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
Void : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
TypedReference : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
IntPtr : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
UIntPtr : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
String : TypeInfo<GenericParamFromMetadata, TypeDefn>
Boolean : TypeInfo<GenericParamFromMetadata, TypeDefn>
Char : TypeInfo<GenericParamFromMetadata, TypeDefn>
SByte : TypeInfo<GenericParamFromMetadata, TypeDefn>
Byte : TypeInfo<GenericParamFromMetadata, TypeDefn>
Int16 : TypeInfo<GenericParamFromMetadata, TypeDefn>
UInt16 : TypeInfo<GenericParamFromMetadata, TypeDefn>
Int32 : TypeInfo<GenericParamFromMetadata, TypeDefn>
UInt32 : TypeInfo<GenericParamFromMetadata, TypeDefn>
Int64 : TypeInfo<GenericParamFromMetadata, TypeDefn>
UInt64 : TypeInfo<GenericParamFromMetadata, TypeDefn>
Single : TypeInfo<GenericParamFromMetadata, TypeDefn>
Double : TypeInfo<GenericParamFromMetadata, TypeDefn>
Array : TypeInfo<GenericParamFromMetadata, TypeDefn>
Enum : TypeInfo<GenericParamFromMetadata, TypeDefn>
ValueType : TypeInfo<GenericParamFromMetadata, TypeDefn>
DelegateType : TypeInfo<GenericParamFromMetadata, TypeDefn>
Object : TypeInfo<GenericParamFromMetadata, TypeDefn>
RuntimeMethodHandle : TypeInfo<GenericParamFromMetadata, TypeDefn>
RuntimeFieldHandle : TypeInfo<GenericParamFromMetadata, TypeDefn>
RuntimeTypeHandle : TypeInfo<GenericParamFromMetadata, TypeDefn>
RuntimeFieldInfoStub : TypeInfo<GenericParamFromMetadata, TypeDefn>
RuntimeFieldHandleInternal : TypeInfo<GenericParamFromMetadata, TypeDefn>
RuntimeType : TypeInfo<GenericParamFromMetadata, TypeDefn>
Void : TypeInfo<GenericParamFromMetadata, TypeDefn>
TypedReference : TypeInfo<GenericParamFromMetadata, TypeDefn>
IntPtr : TypeInfo<GenericParamFromMetadata, TypeDefn>
UIntPtr : TypeInfo<GenericParamFromMetadata, TypeDefn>
}
[<RequireQualifiedAccess>]
@@ -198,7 +198,7 @@ module TypeInfo =
(thisAssembly : AssemblyName)
(metadataReader : MetadataReader)
(typeHandle : TypeDefinitionHandle)
: TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
: TypeInfo<GenericParamFromMetadata, TypeDefn>
=
let typeDef = metadataReader.GetTypeDefinition typeHandle
let methods = typeDef.GetMethods ()

1
WoofWare.PawPrint.Domain/WoofWare.PawPrint.Domain.fsproj
View File

@@ -11,6 +11,7 @@
<Compile Include="TypeRef.fs" />
<Compile Include="IlOp.fs" />
<Compile Include="CustomAttribute.fs" />
<Compile Include="GenericParameter.fs" />
<Compile Include="AssemblyReference.fs" />
<Compile Include="EventDefn.fs" />
<Compile Include="ComparableTypeDefinitionHandle.fs" />

2
WoofWare.PawPrint/BasicCliType.fs
View File

@@ -326,7 +326,7 @@ module CliType =
(corelib : BaseClassTypes<DumpedAssembly>)
(handle : ConcreteTypeHandle)
(concreteType : ConcreteType<ConcreteTypeHandle>)
(typeDef : WoofWare.PawPrint.TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>)
(typeDef : WoofWare.PawPrint.TypeInfo<GenericParamFromMetadata, TypeDefn>)
(visited : Set<ConcreteTypeHandle>)
: CliType * AllConcreteTypes
=

28
WoofWare.PawPrint/IlMachineState.fs
View File

@@ -378,7 +378,7 @@ module IlMachineState =
let defn =
assy.TypeDefs.[defn.Get]
|> TypeInfo.mapGeneric (fun _ param -> typeGenericArgs.[param.SequenceNumber])
|> TypeInfo.mapGeneric (fun _ (param, _) -> typeGenericArgs.[param.SequenceNumber])
state, assy, defn
| TypeDefn.FromReference (ref, _typeKind) ->
@@ -773,7 +773,7 @@ module IlMachineState =
(loggerFactory : ILoggerFactory)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(typeGenerics : ImmutableArray<ConcreteTypeHandle>)
(methodToCall : WoofWare.PawPrint.MethodInfo<TypeDefn, WoofWare.PawPrint.GenericParameter, TypeDefn>)
(methodToCall : WoofWare.PawPrint.MethodInfo<TypeDefn, GenericParamFromMetadata, TypeDefn>)
(methodGenerics : TypeDefn ImmutableArray option)
(callingAssembly : AssemblyName)
(currentExecutingMethodGenerics : ImmutableArray<ConcreteTypeHandle>)
@@ -850,7 +850,7 @@ module IlMachineState =
(loggerFactory : ILoggerFactory)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(thread : ThreadId)
(methodToCall : WoofWare.PawPrint.MethodInfo<TypeDefn, WoofWare.PawPrint.GenericParameter, TypeDefn>)
(methodToCall : WoofWare.PawPrint.MethodInfo<TypeDefn, GenericParamFromMetadata, TypeDefn>)
(methodGenerics : TypeDefn ImmutableArray option)
(typeArgsFromMetadata : TypeDefn ImmutableArray option)
(state : IlMachineState)
@@ -1199,7 +1199,7 @@ module IlMachineState =
: IlMachineState *
AssemblyName *
Choice<
WoofWare.PawPrint.MethodInfo<TypeDefn, WoofWare.PawPrint.GenericParameter, TypeDefn>,
WoofWare.PawPrint.MethodInfo<TypeDefn, GenericParamFromMetadata, TypeDefn>,
WoofWare.PawPrint.FieldInfo<TypeDefn, TypeDefn>
> *
TypeDefn ImmutableArray
@@ -1362,7 +1362,9 @@ module IlMachineState =
| [] ->
failwith
$"Could not find member {memberName} with the right signature {memberSig} on {targetType.Namespace}.{targetType.Name}"
| [ x ] -> x |> MethodInfo.mapTypeGenerics (fun i _ -> targetType.Generics.[i])
| [ x ] ->
x
|> MethodInfo.mapTypeGenerics (fun (par, _) -> targetType.Generics.[par.SequenceNumber])
| _ ->
failwith
$"Multiple overloads matching signature for call to {targetType.Namespace}.{targetType.Name}'s {memberName}!"
@@ -1480,15 +1482,13 @@ module IlMachineState =
=
let field = state.LoadedAssembly(declaringAssy).Value.Fields.[fieldHandle]
// For LdToken, we don't have generic context, so we create a non-generic type
// TODO: This might need to be revisited if we need to support generic field handles
let declaringTypeWithGenerics : ConcreteType<TypeDefn> =
ConcreteType.make
field.DeclaringType.Assembly
field.DeclaringType.Namespace
field.DeclaringType.Name
field.DeclaringType.Definition.Get
ImmutableArray.Empty // No generic arguments in this context
// For LdToken, we need to convert GenericParamFromMetadata to TypeDefn
// When we don't have generic context, we use the generic type parameters directly
let declaringTypeWithGenerics =
field.DeclaringType
|> ConcreteType.mapGeneric (fun _index (param, _metadata) ->
TypeDefn.GenericTypeParameter param.SequenceNumber
)
let declaringType, state =
concretizeFieldDeclaringType loggerFactory baseClassTypes declaringTypeWithGenerics state

5
WoofWare.PawPrint/IlMachineStateExecution.fs
View File

@@ -361,7 +361,8 @@ module IlMachineStateExecution =
// Convert the method's type generics from TypeDefn to ConcreteTypeHandle
let cctorMethodWithTypeGenerics =
cctorMethod |> MethodInfo.mapTypeGenerics (fun i _ -> concreteType.Generics.[i])
cctorMethod
|> MethodInfo.mapTypeGenerics (fun (par, _) -> concreteType.Generics.[par.SequenceNumber])
// Convert method generics (should be empty for cctor)
let cctorMethodWithMethodGenerics =
@@ -472,7 +473,7 @@ module IlMachineStateExecution =
(thread : ThreadId)
(advanceProgramCounterOfCaller : bool)
(methodGenerics : TypeDefn ImmutableArray option)
(methodToCall : WoofWare.PawPrint.MethodInfo<TypeDefn, WoofWare.PawPrint.GenericParameter, TypeDefn>)
(methodToCall : WoofWare.PawPrint.MethodInfo<TypeDefn, GenericParamFromMetadata, TypeDefn>)
(weAreConstructingObj : ManagedHeapAddress option)
(typeArgsFromMetadata : TypeDefn ImmutableArray option)
(state : IlMachineState)

14
WoofWare.PawPrint/ImmutableArray.fs Normal file
View File

@@ -0,0 +1,14 @@
namespace WoofWare.PawPrint
open System.Collections.Immutable
[<RequireQualifiedAccess>]
module internal ImmutableArray =
let map (f : 'a -> 'b) (arr : ImmutableArray<'a>) : ImmutableArray<'b> =
let b = ImmutableArray.CreateBuilder ()
for i in arr do
b.Add (f i)
b.ToImmutable ()

8
WoofWare.PawPrint/Program.fs
View File

@@ -94,7 +94,7 @@ module Program =
(currentAssembly : DumpedAssembly)
(continueWithGeneric :
IlMachineState
-> TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
-> TypeInfo<GenericParamFromMetadata, TypeDefn>
-> DumpedAssembly
-> IlMachineState * BaseClassTypes<DumpedAssembly> option)
(continueWithResolved :
@@ -145,7 +145,7 @@ module Program =
let rec findCoreLibraryAssemblyFromGeneric
(state : IlMachineState)
(currentType : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>)
(currentType : TypeInfo<GenericParamFromMetadata, TypeDefn>)
(currentAssembly : DumpedAssembly)
=
match currentType.BaseType with
@@ -186,7 +186,7 @@ module Program =
// Use the original method from metadata, but convert FakeUnit to TypeDefn
let rawMainMethod =
mainMethodFromMetadata
|> MethodInfo.mapTypeGenerics (fun i _ -> TypeDefn.GenericTypeParameter i)
|> MethodInfo.mapTypeGenerics (fun (i, _) -> TypeDefn.GenericTypeParameter i.SequenceNumber)
let state, concretizedMainMethod, _ =
IlMachineState.concretizeMethodWithTypeGenerics
@@ -233,7 +233,7 @@ module Program =
| Some baseTypes ->
let rawMainMethod =
mainMethodFromMetadata
|> MethodInfo.mapTypeGenerics (fun i _ -> TypeDefn.GenericTypeParameter i)
|> MethodInfo.mapTypeGenerics (fun (i, _) -> TypeDefn.GenericTypeParameter i.SequenceNumber)
IlMachineState.concretizeMethodWithTypeGenerics
loggerFactory

18
WoofWare.PawPrint/UnaryMetadataIlOp.fs
View File

@@ -126,7 +126,9 @@ module internal UnaryMetadataIlOp =
| MetadataToken.MethodDef token ->
let method =
activeAssy.Methods.[token]
|> MethodInfo.mapTypeGenerics (fun i _ -> TypeDefn.GenericTypeParameter i)
|> MethodInfo.mapTypeGenerics (fun (par, _) ->
TypeDefn.GenericTypeParameter par.SequenceNumber
)
state, method, Some spec.Signature, None
| MetadataToken.MemberReference ref ->
@@ -209,7 +211,7 @@ module internal UnaryMetadataIlOp =
| MetadataToken.MethodDef token ->
let method =
activeAssy.Methods.[token]
|> MethodInfo.mapTypeGenerics (fun i _ -> spec.Signature.[i])
|> MethodInfo.mapTypeGenerics (fun (p, _) -> spec.Signature.[p.SequenceNumber])
state, method, Some spec.Signature, None
| MetadataToken.MemberReference ref ->
@@ -872,7 +874,7 @@ module internal UnaryMetadataIlOp =
state,
activeAssy,
activeAssy.TypeDefs.[defn]
|> TypeInfo.mapGeneric (fun _ p -> TypeDefn.GenericTypeParameter p.SequenceNumber)
|> TypeInfo.mapGeneric (fun _ (p, _) -> TypeDefn.GenericTypeParameter p.SequenceNumber)
| MetadataToken.TypeSpecification spec ->
let state, assy, ty =
IlMachineState.resolveTypeFromSpecConcrete
@@ -936,7 +938,7 @@ module internal UnaryMetadataIlOp =
state,
activeAssy,
activeAssy.TypeDefs.[defn]
|> TypeInfo.mapGeneric (fun _ p -> TypeDefn.GenericTypeParameter p.SequenceNumber)
|> TypeInfo.mapGeneric (fun _ (p, _) -> TypeDefn.GenericTypeParameter p.SequenceNumber)
| MetadataToken.TypeSpecification spec ->
let state, assy, ty =
IlMachineState.resolveTypeFromSpecConcrete
@@ -1026,12 +1028,12 @@ module internal UnaryMetadataIlOp =
failwith "TODO: Ldsflda - push unmanaged pointer"
| Ldftn ->
let (method : MethodInfo<TypeDefn, WoofWare.PawPrint.GenericParameter, TypeDefn>), methodGenerics =
let method, methodGenerics =
match metadataToken with
| MetadataToken.MethodDef handle ->
let method =
activeAssy.Methods.[handle]
|> MethodInfo.mapTypeGenerics (fun i _ -> TypeDefn.GenericTypeParameter i)
|> MethodInfo.mapTypeGenerics (fun (par, _) -> TypeDefn.GenericTypeParameter par.SequenceNumber)
method, None
| MetadataToken.MethodSpecification h ->
@@ -1041,7 +1043,9 @@ module internal UnaryMetadataIlOp =
| MetadataToken.MethodDef token ->
let method =
activeAssy.Methods.[token]
|> MethodInfo.mapTypeGenerics (fun i _ -> TypeDefn.GenericTypeParameter i)
|> MethodInfo.mapTypeGenerics (fun (par, _) ->
TypeDefn.GenericTypeParameter par.SequenceNumber
)
method, Some spec.Signature
| k -> failwith $"Unrecognised MethodSpecification kind: %O{k}"