mirror of
https://github.com/Smaug123/WoofWare.PawPrint
synced 2025-10-05 14:18:40 +00:00
Concrete types - lots of tech debt in here (#79)
This commit is contained in:
74
CLAUDE.md
74
CLAUDE.md
@@ -100,3 +100,77 @@ It strongly prefers to avoid special-casing to get around problems, but instead
|
||||
### Common Gotchas
|
||||
|
||||
* I've named several types in such a way as to overlap with built-in types, e.g. MethodInfo is in both WoofWare.PawPrint and System.Reflection.Metadata namespaces. Build errors can usually be fixed by fully-qualifying the type.
|
||||
|
||||
## Type Concretization System
|
||||
|
||||
### Overview
|
||||
|
||||
Type concretization converts abstract type definitions (`TypeDefn`) to concrete runtime types (`ConcreteTypeHandle`). This is essential because IL operations need exact types at runtime, including all generic instantiations. The system separates type concretization from IL execution, ensuring types are properly loaded before use.
|
||||
|
||||
### Key Concepts
|
||||
|
||||
#### Generic Parameters
|
||||
- **Common error**: "Generic type/method parameter X out of range" probably means you're missing the proper generic context: some caller has passed the wrong list of generics through somewhere.
|
||||
|
||||
#### Assembly Context
|
||||
TypeRefs must be resolved in the context of the assembly where they're defined, not where they're used. When resolving a TypeRef, always use the assembly that contains the TypeRef in its metadata.
|
||||
|
||||
### Common Scenarios and Solutions
|
||||
|
||||
#### Nested Generic Contexts
|
||||
When inside `Array.Empty<T>()` calling `AsRef<T>`, the `T` refers to the outer method's generic parameter. Pass the current executing method's generics as context:
|
||||
```fsharp
|
||||
let currentMethod = state.ThreadState.[thread].MethodState.ExecutingMethod
|
||||
concretizeMethodWithTypeGenerics ... currentMethod.Generics state
|
||||
```
|
||||
|
||||
#### Field Access in Generic Contexts
|
||||
When accessing `EmptyArray<T>.Value` from within `Array.Empty<T>()`, use both type and method generics:
|
||||
```fsharp
|
||||
let contextTypeGenerics = currentMethod.DeclaringType.Generics
|
||||
let contextMethodGenerics = currentMethod.Generics
|
||||
```
|
||||
|
||||
#### Call vs CallMethod
|
||||
- `callMethodInActiveAssembly` expects unconcretized methods and does concretization internally
|
||||
- `callMethod` expects already-concretized methods
|
||||
- The refactoring changed to concretizing before calling to ensure types are loaded
|
||||
|
||||
### Common Pitfalls
|
||||
|
||||
1. **Don't create new generic parameters when they already exist**. It's *very rarely* correct to instantiate `TypeDefn.Generic{Type,Method}Parameter` yourself:
|
||||
```fsharp
|
||||
// Wrong: field.DeclaringType.Generics |> List.mapi (fun i _ -> TypeDefn.GenericTypeParameter i)
|
||||
// Right: field.DeclaringType.Generics
|
||||
```
|
||||
|
||||
2. **Assembly loading context**: The `loadAssembly` function expects the assembly that contains the reference as the first parameter, not the target assembly
|
||||
|
||||
3. **Type forwarding**: Use `Assembly.resolveTypeRef` which handles type forwarding and exported types correctly
|
||||
|
||||
### Key Files for Type System
|
||||
|
||||
- **TypeConcretisation.fs**: Core type concretization logic
|
||||
- `concretizeType`: Main entry point
|
||||
- `concretizeGenericInstantiation`: Handles generic instantiations like `List<T>`
|
||||
- `ConcretizationContext`: Tracks state during concretization
|
||||
|
||||
- **IlMachineState.fs**:
|
||||
- `concretizeMethodForExecution`: Prepares methods for execution
|
||||
- `concretizeFieldForExecution`: Prepares fields for access
|
||||
- Manages the flow of generic contexts through execution
|
||||
|
||||
- **Assembly.fs**:
|
||||
- `resolveTypeRef`: Resolves type references across assemblies
|
||||
- `resolveTypeFromName`: Handles type forwarding and exported types
|
||||
- `resolveTypeFromExport`: Follows type forwarding chains
|
||||
|
||||
### Debugging Type Concretization Issues
|
||||
|
||||
When encountering errors:
|
||||
1. Check the generic context (method name, generic parameters)
|
||||
2. Verify the assembly context being used
|
||||
3. Identify the TypeDefn variant being concretized
|
||||
4. Add logging to see generic contexts: `failwithf "Failed to concretize: %A" typeDefn`
|
||||
5. Check if you're in a generic method calling another generic method
|
||||
6. Verify TypeRefs are being resolved in the correct assembly
|
||||
|
@@ -429,50 +429,52 @@ module Assembly =
|
||||
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||
(referencedInAssembly : DumpedAssembly)
|
||||
(target : TypeRef)
|
||||
(genericArgs : ImmutableArray<TypeDefn> option)
|
||||
(genericArgs : ImmutableArray<TypeDefn>)
|
||||
: TypeResolutionResult
|
||||
=
|
||||
match target.ResolutionScope with
|
||||
| TypeRefResolutionScope.Assembly r ->
|
||||
let assemblyRef = referencedInAssembly.AssemblyReferences.[r]
|
||||
match referencedInAssembly.AssemblyReferences.TryGetValue r with
|
||||
| false, _ ->
|
||||
failwithf
|
||||
"AssemblyReferenceHandle %A not found in assembly %s. Available references: %A"
|
||||
r
|
||||
referencedInAssembly.Name.FullName
|
||||
(referencedInAssembly.AssemblyReferences.Keys |> Seq.toList)
|
||||
| true, assemblyRef ->
|
||||
|
||||
let assemblyName = assemblyRef.Name
|
||||
|
||||
match assemblies.TryGetValue assemblyName.FullName with
|
||||
| false, _ -> TypeResolutionResult.FirstLoadAssy assemblyRef
|
||||
| true, assy ->
|
||||
|
||||
let nsPath = target.Namespace.Split '.' |> Array.toList
|
||||
let nsPath = target.Namespace.Split '.' |> Array.toList
|
||||
|
||||
let targetNs = assy.NonRootNamespaces.[nsPath]
|
||||
let targetNs = assy.NonRootNamespaces.[nsPath]
|
||||
|
||||
let targetType =
|
||||
targetNs.TypeDefinitions
|
||||
|> Seq.choose (fun td ->
|
||||
let ty = assy.TypeDefs.[td]
|
||||
let targetType =
|
||||
targetNs.TypeDefinitions
|
||||
|> Seq.choose (fun td ->
|
||||
let ty = assy.TypeDefs.[td]
|
||||
|
||||
if ty.Name = target.Name && ty.Namespace = target.Namespace then
|
||||
Some ty
|
||||
else
|
||||
None
|
||||
)
|
||||
|> Seq.toList
|
||||
|
||||
match targetType with
|
||||
| [ t ] ->
|
||||
let t =
|
||||
t
|
||||
|> TypeInfo.mapGeneric (fun _ param ->
|
||||
match genericArgs with
|
||||
| None -> failwith "got a generic TypeRef but no generic args in context"
|
||||
| Some genericArgs -> genericArgs.[param.SequenceNumber]
|
||||
if ty.Name = target.Name && ty.Namespace = target.Namespace then
|
||||
Some ty
|
||||
else
|
||||
None
|
||||
)
|
||||
|> Seq.toList
|
||||
|
||||
TypeResolutionResult.Resolved (assy, t)
|
||||
| _ :: _ :: _ -> failwith $"Multiple matching type definitions! {nsPath} {target.Name}"
|
||||
| [] ->
|
||||
match assy.ExportedType (Some target.Namespace) target.Name with
|
||||
| None -> failwith $"Failed to find type {nsPath} {target.Name} in {assy.Name.FullName}!"
|
||||
| Some ty -> resolveTypeFromExport assy assemblies ty genericArgs
|
||||
match targetType with
|
||||
| [ t ] ->
|
||||
let t = t |> TypeInfo.mapGeneric (fun _ param -> genericArgs.[param.SequenceNumber])
|
||||
|
||||
TypeResolutionResult.Resolved (assy, t)
|
||||
| _ :: _ :: _ -> failwith $"Multiple matching type definitions! {nsPath} {target.Name}"
|
||||
| [] ->
|
||||
match assy.ExportedType (Some target.Namespace) target.Name with
|
||||
| None -> failwith $"Failed to find type {nsPath} {target.Name} in {assy.Name.FullName}!"
|
||||
| Some ty -> resolveTypeFromExport assy assemblies ty genericArgs
|
||||
| k -> failwith $"Unexpected: {k}"
|
||||
|
||||
and resolveTypeFromName
|
||||
@@ -480,7 +482,7 @@ module Assembly =
|
||||
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||
(ns : string option)
|
||||
(name : string)
|
||||
(genericArgs : ImmutableArray<TypeDefn> option)
|
||||
(genericArgs : ImmutableArray<TypeDefn>)
|
||||
: TypeResolutionResult
|
||||
=
|
||||
match ns with
|
||||
@@ -491,11 +493,7 @@ module Assembly =
|
||||
| Some typeDef ->
|
||||
let typeDef =
|
||||
typeDef
|
||||
|> TypeInfo.mapGeneric (fun _ param ->
|
||||
match genericArgs with
|
||||
| None -> failwith<TypeDefn> $"tried to resolve generic type {ns}.{name} but no generics in scope"
|
||||
| Some genericArgs -> genericArgs.[param.SequenceNumber]
|
||||
)
|
||||
|> TypeInfo.mapGeneric (fun _ param -> genericArgs.[param.SequenceNumber])
|
||||
|
||||
TypeResolutionResult.Resolved (assy, typeDef)
|
||||
| None ->
|
||||
@@ -512,7 +510,7 @@ module Assembly =
|
||||
(fromAssembly : DumpedAssembly)
|
||||
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||
(ty : WoofWare.PawPrint.ExportedType)
|
||||
(genericArgs : ImmutableArray<TypeDefn> option)
|
||||
(genericArgs : ImmutableArray<TypeDefn>)
|
||||
: TypeResolutionResult
|
||||
=
|
||||
match ty.Data with
|
||||
@@ -538,7 +536,7 @@ module DumpedAssembly =
|
||||
| Some (BaseTypeInfo.TypeRef r) ->
|
||||
let assy = loadedAssemblies.[source.FullName]
|
||||
// TODO: generics
|
||||
match Assembly.resolveTypeRef loadedAssemblies assy assy.TypeRefs.[r] None with
|
||||
match Assembly.resolveTypeRef loadedAssemblies assy assy.TypeRefs.[r] ImmutableArray.Empty with
|
||||
| TypeResolutionResult.FirstLoadAssy _ ->
|
||||
failwith
|
||||
"seems pretty unlikely that we could have constructed this object without loading its base type"
|
||||
|
@@ -75,8 +75,6 @@ type ConcreteType<'typeGeneric when 'typeGeneric : comparison and 'typeGeneric :
|
||||
(this :> IComparable<ConcreteType<'typeGeneric>>).CompareTo other
|
||||
| _ -> failwith "bad comparison"
|
||||
|
||||
type RuntimeConcreteType = ConcreteType<TypeDefn>
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module ConcreteType =
|
||||
let make
|
||||
@@ -85,7 +83,7 @@ module ConcreteType =
|
||||
(name : string)
|
||||
(defn : TypeDefinitionHandle)
|
||||
(generics : TypeDefn list)
|
||||
: RuntimeConcreteType
|
||||
: ConcreteType<TypeDefn>
|
||||
=
|
||||
{
|
||||
_AssemblyName = assemblyName
|
||||
|
900
WoofWare.PawPrint.Domain/TypeConcretisation.fs
Normal file
900
WoofWare.PawPrint.Domain/TypeConcretisation.fs
Normal file
@@ -0,0 +1,900 @@
|
||||
namespace WoofWare.PawPrint
|
||||
|
||||
open System.Collections.Immutable
|
||||
open System.Reflection
|
||||
open System.Reflection.Metadata
|
||||
|
||||
type ConcreteTypeHandle =
|
||||
| Concrete of int
|
||||
| Byref of ConcreteTypeHandle
|
||||
| Pointer of ConcreteTypeHandle
|
||||
|
||||
type AllConcreteTypes =
|
||||
{
|
||||
Mapping : Map<int, ConcreteType<ConcreteTypeHandle>>
|
||||
NextHandle : int
|
||||
}
|
||||
|
||||
static member Empty =
|
||||
{
|
||||
Mapping = Map.empty
|
||||
NextHandle = 0
|
||||
}
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module AllConcreteTypes =
|
||||
let lookup (cth : ConcreteTypeHandle) (this : AllConcreteTypes) : ConcreteType<ConcreteTypeHandle> option =
|
||||
match cth with
|
||||
| ConcreteTypeHandle.Concrete id -> this.Mapping |> Map.tryFind id
|
||||
| ConcreteTypeHandle.Byref _ -> None // Byref types are not stored in the mapping
|
||||
| ConcreteTypeHandle.Pointer _ -> None // Pointer types are not stored in the mapping
|
||||
|
||||
let lookup' (ct : ConcreteType<ConcreteTypeHandle>) (this : AllConcreteTypes) : ConcreteTypeHandle option =
|
||||
this.Mapping
|
||||
|> Map.tryPick (fun id existingCt ->
|
||||
if
|
||||
existingCt._AssemblyName = ct._AssemblyName
|
||||
&& existingCt._Namespace = ct._Namespace
|
||||
&& existingCt._Name = ct._Name
|
||||
&& existingCt._Definition = ct._Definition
|
||||
&& existingCt._Generics = ct._Generics
|
||||
then
|
||||
Some (ConcreteTypeHandle.Concrete id)
|
||||
else
|
||||
None
|
||||
)
|
||||
|
||||
let findExistingConcreteType
|
||||
(concreteTypes : AllConcreteTypes)
|
||||
(asm : AssemblyName, ns : string, name : string, generics : ConcreteTypeHandle list as key)
|
||||
: ConcreteTypeHandle option
|
||||
=
|
||||
concreteTypes.Mapping
|
||||
|> Map.tryPick (fun id ct ->
|
||||
if
|
||||
ct.Assembly.FullName = asm.FullName
|
||||
&& ct.Namespace = ns
|
||||
&& ct.Name = name
|
||||
&& ct.Generics = generics
|
||||
then
|
||||
Some (ConcreteTypeHandle.Concrete id)
|
||||
else
|
||||
None
|
||||
)
|
||||
|
||||
/// `source` is AssemblyName * Namespace * Name
|
||||
let add (ct : ConcreteType<ConcreteTypeHandle>) (this : AllConcreteTypes) : ConcreteTypeHandle * AllConcreteTypes =
|
||||
let id = this.NextHandle
|
||||
let toRet = ConcreteTypeHandle.Concrete id
|
||||
|
||||
let newState =
|
||||
{
|
||||
NextHandle = this.NextHandle + 1
|
||||
Mapping = this.Mapping |> Map.add id ct
|
||||
}
|
||||
|
||||
toRet, newState
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module TypeConcretization =
|
||||
|
||||
type ConcretizationContext =
|
||||
{
|
||||
/// Types currently being processed (to detect cycles)
|
||||
InProgress : ImmutableDictionary<AssemblyName * TypeDefn, ConcreteTypeHandle>
|
||||
/// All concrete types created so far
|
||||
ConcreteTypes : AllConcreteTypes
|
||||
/// For resolving type references
|
||||
LoadedAssemblies : ImmutableDictionary<string, DumpedAssembly>
|
||||
BaseTypes : BaseClassTypes<DumpedAssembly>
|
||||
}
|
||||
|
||||
// Helper function to find existing types by assembly, namespace, name, and generics
|
||||
let private findExistingType
|
||||
(concreteTypes : AllConcreteTypes)
|
||||
(assembly : AssemblyName)
|
||||
(ns : string)
|
||||
(name : string)
|
||||
(generics : ConcreteTypeHandle list)
|
||||
: ConcreteTypeHandle option
|
||||
=
|
||||
concreteTypes.Mapping
|
||||
|> Map.tryPick (fun id ct ->
|
||||
if
|
||||
ct.Assembly.FullName = assembly.FullName
|
||||
&& ct.Namespace = ns
|
||||
&& ct.Name = name
|
||||
&& ct.Generics = generics
|
||||
then
|
||||
Some (ConcreteTypeHandle.Concrete id)
|
||||
else
|
||||
None
|
||||
)
|
||||
|
||||
// Helper function for primitive types (convenience wrapper)
|
||||
let private findExistingPrimitiveType
|
||||
(concreteTypes : AllConcreteTypes)
|
||||
(key : AssemblyName * string * string)
|
||||
: ConcreteTypeHandle option
|
||||
=
|
||||
let (asm, ns, name) = key
|
||||
findExistingType concreteTypes asm ns name []
|
||||
|
||||
// Helper function to create and add a ConcreteType to the context
|
||||
let private createAndAddConcreteType
|
||||
(ctx : ConcretizationContext)
|
||||
(assembly : AssemblyName)
|
||||
(definition : ComparableTypeDefinitionHandle)
|
||||
(ns : string)
|
||||
(name : string)
|
||||
(generics : ConcreteTypeHandle list)
|
||||
: ConcreteTypeHandle * ConcretizationContext
|
||||
=
|
||||
let concreteType =
|
||||
{
|
||||
_AssemblyName = assembly
|
||||
_Definition = definition
|
||||
_Namespace = ns
|
||||
_Name = name
|
||||
_Generics = generics
|
||||
}
|
||||
|
||||
let handle, newConcreteTypes = AllConcreteTypes.add concreteType ctx.ConcreteTypes
|
||||
|
||||
let newCtx =
|
||||
{ ctx with
|
||||
ConcreteTypes = newConcreteTypes
|
||||
}
|
||||
|
||||
handle, newCtx
|
||||
|
||||
// Helper function for assembly loading with retry pattern
|
||||
let private loadAssemblyAndResolveTypeRef
|
||||
(loadAssembly :
|
||||
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
|
||||
(ctx : ConcretizationContext)
|
||||
(currentAssembly : AssemblyName)
|
||||
(typeRef : TypeRef)
|
||||
: (DumpedAssembly * WoofWare.PawPrint.TypeInfo<_, _>) * ConcretizationContext
|
||||
=
|
||||
let currentAssy =
|
||||
match ctx.LoadedAssemblies.TryGetValue currentAssembly.FullName with
|
||||
| false, _ -> failwithf "Current assembly %s not loaded" currentAssembly.FullName
|
||||
| true, assy -> assy
|
||||
|
||||
// First try to resolve without loading new assemblies
|
||||
let resolutionResult =
|
||||
Assembly.resolveTypeRef ctx.LoadedAssemblies currentAssy typeRef ImmutableArray.Empty
|
||||
|
||||
match resolutionResult with
|
||||
| TypeResolutionResult.Resolved (targetAssy, typeInfo) -> (targetAssy, typeInfo), ctx
|
||||
| TypeResolutionResult.FirstLoadAssy assemblyRef ->
|
||||
// Need to load the assembly
|
||||
match typeRef.ResolutionScope with
|
||||
| TypeRefResolutionScope.Assembly assyRef ->
|
||||
let newAssemblies, loadedAssy = loadAssembly currentAssembly assyRef
|
||||
|
||||
let newCtx =
|
||||
{ ctx with
|
||||
LoadedAssemblies = newAssemblies
|
||||
}
|
||||
|
||||
// Now try to resolve again with the loaded assembly
|
||||
let resolutionResult2 =
|
||||
Assembly.resolveTypeRef newCtx.LoadedAssemblies currentAssy typeRef ImmutableArray.Empty
|
||||
|
||||
match resolutionResult2 with
|
||||
| TypeResolutionResult.Resolved (targetAssy, typeInfo) -> (targetAssy, typeInfo), newCtx
|
||||
| TypeResolutionResult.FirstLoadAssy _ ->
|
||||
failwithf "Failed to resolve type %s.%s after loading assembly" typeRef.Namespace typeRef.Name
|
||||
| _ -> failwith "Unexpected resolution scope"
|
||||
|
||||
let private concretizePrimitive
|
||||
(ctx : ConcretizationContext)
|
||||
(prim : PrimitiveType)
|
||||
: ConcreteTypeHandle * ConcretizationContext
|
||||
=
|
||||
|
||||
// Get the TypeInfo for this primitive from BaseClassTypes
|
||||
let typeInfo =
|
||||
match prim with
|
||||
| PrimitiveType.Boolean -> ctx.BaseTypes.Boolean
|
||||
| PrimitiveType.Char -> ctx.BaseTypes.Char
|
||||
| PrimitiveType.SByte -> ctx.BaseTypes.SByte
|
||||
| PrimitiveType.Byte -> ctx.BaseTypes.Byte
|
||||
| PrimitiveType.Int16 -> ctx.BaseTypes.Int16
|
||||
| PrimitiveType.UInt16 -> ctx.BaseTypes.UInt16
|
||||
| PrimitiveType.Int32 -> ctx.BaseTypes.Int32
|
||||
| PrimitiveType.UInt32 -> ctx.BaseTypes.UInt32
|
||||
| PrimitiveType.Int64 -> ctx.BaseTypes.Int64
|
||||
| PrimitiveType.UInt64 -> ctx.BaseTypes.UInt64
|
||||
| PrimitiveType.Single -> ctx.BaseTypes.Single
|
||||
| PrimitiveType.Double -> ctx.BaseTypes.Double
|
||||
| PrimitiveType.String -> ctx.BaseTypes.String
|
||||
| PrimitiveType.Object -> ctx.BaseTypes.Object
|
||||
| PrimitiveType.TypedReference -> ctx.BaseTypes.TypedReference
|
||||
| PrimitiveType.IntPtr -> ctx.BaseTypes.IntPtr
|
||||
| PrimitiveType.UIntPtr -> ctx.BaseTypes.UIntPtr
|
||||
|
||||
// Check if we've already concretized this primitive type
|
||||
let key = (typeInfo.Assembly, typeInfo.Namespace, typeInfo.Name)
|
||||
|
||||
match findExistingPrimitiveType ctx.ConcreteTypes key with
|
||||
| Some handle -> handle, ctx
|
||||
| None ->
|
||||
// Create and add the concrete type (primitives have no generic arguments)
|
||||
createAndAddConcreteType
|
||||
ctx
|
||||
typeInfo.Assembly
|
||||
(ComparableTypeDefinitionHandle.Make typeInfo.TypeDefHandle)
|
||||
typeInfo.Namespace
|
||||
typeInfo.Name
|
||||
[] // Primitives have no generic parameters
|
||||
|
||||
let private concretizeArray
|
||||
(ctx : ConcretizationContext)
|
||||
(elementHandle : ConcreteTypeHandle)
|
||||
(shape : 'a)
|
||||
: ConcreteTypeHandle * ConcretizationContext
|
||||
=
|
||||
|
||||
// Arrays are System.Array<T> where T is the element type
|
||||
let arrayTypeInfo = ctx.BaseTypes.Array
|
||||
|
||||
// Check if we've already concretized this array type
|
||||
match
|
||||
findExistingType
|
||||
ctx.ConcreteTypes
|
||||
arrayTypeInfo.Assembly
|
||||
arrayTypeInfo.Namespace
|
||||
arrayTypeInfo.Name
|
||||
[ elementHandle ]
|
||||
with
|
||||
| Some handle -> handle, ctx
|
||||
| None ->
|
||||
// Create and add the concrete array type
|
||||
createAndAddConcreteType
|
||||
ctx
|
||||
arrayTypeInfo.Assembly
|
||||
(ComparableTypeDefinitionHandle.Make arrayTypeInfo.TypeDefHandle)
|
||||
arrayTypeInfo.Namespace
|
||||
arrayTypeInfo.Name
|
||||
[ elementHandle ] // Array<T> has one generic parameter
|
||||
|
||||
let private concretizeOneDimArray
|
||||
(ctx : ConcretizationContext)
|
||||
(elementHandle : ConcreteTypeHandle)
|
||||
: ConcreteTypeHandle * ConcretizationContext
|
||||
=
|
||||
|
||||
// One-dimensional arrays with lower bound 0 are also System.Array<T>
|
||||
// They just have different IL instructions for access
|
||||
let arrayTypeInfo = ctx.BaseTypes.Array
|
||||
|
||||
// Check if we've already concretized this array type
|
||||
match
|
||||
findExistingType
|
||||
ctx.ConcreteTypes
|
||||
arrayTypeInfo.Assembly
|
||||
arrayTypeInfo.Namespace
|
||||
arrayTypeInfo.Name
|
||||
[ elementHandle ]
|
||||
with
|
||||
| Some handle -> handle, ctx
|
||||
| None ->
|
||||
// Create and add the concrete array type
|
||||
createAndAddConcreteType
|
||||
ctx
|
||||
arrayTypeInfo.Assembly
|
||||
(ComparableTypeDefinitionHandle.Make arrayTypeInfo.TypeDefHandle)
|
||||
arrayTypeInfo.Namespace
|
||||
arrayTypeInfo.Name
|
||||
[ elementHandle ] // Array<T> has one generic parameter
|
||||
|
||||
let concretizeTypeDefinition
|
||||
(ctx : ConcretizationContext)
|
||||
(assemblyName : AssemblyName)
|
||||
(typeDefHandle : ComparableTypeDefinitionHandle)
|
||||
: ConcreteTypeHandle * ConcretizationContext
|
||||
=
|
||||
|
||||
// Look up the type definition in the assembly
|
||||
let assembly =
|
||||
match ctx.LoadedAssemblies.TryGetValue assemblyName.FullName with
|
||||
| false, _ -> failwithf "Cannot concretize type definition - assembly %s not loaded" assemblyName.FullName
|
||||
| true, assy -> assy
|
||||
|
||||
let typeInfo = assembly.TypeDefs.[typeDefHandle.Get]
|
||||
|
||||
// Check if this type has generic parameters
|
||||
if not typeInfo.Generics.IsEmpty then
|
||||
failwithf
|
||||
"Cannot concretize open generic type %s.%s - it has %d generic parameters"
|
||||
typeInfo.Namespace
|
||||
typeInfo.Name
|
||||
typeInfo.Generics.Length
|
||||
|
||||
// Check if we've already concretized this type
|
||||
match findExistingType ctx.ConcreteTypes assemblyName typeInfo.Namespace typeInfo.Name [] with
|
||||
| Some handle -> handle, ctx
|
||||
| None ->
|
||||
// Create and add the concrete type (no generic arguments since it's not generic)
|
||||
createAndAddConcreteType ctx assemblyName typeDefHandle typeInfo.Namespace typeInfo.Name [] // No generic parameters
|
||||
|
||||
let private concretizeTypeReference
|
||||
(loadAssembly :
|
||||
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
|
||||
(ctx : ConcretizationContext)
|
||||
(currentAssembly : AssemblyName)
|
||||
(typeRef : TypeRef)
|
||||
: ConcreteTypeHandle * ConcretizationContext
|
||||
=
|
||||
// Use the helper to load assembly and resolve the type reference
|
||||
let (targetAssy, typeInfo), ctx =
|
||||
loadAssemblyAndResolveTypeRef loadAssembly ctx currentAssembly typeRef
|
||||
|
||||
// Check if this type has generic parameters
|
||||
if not typeInfo.Generics.IsEmpty then
|
||||
failwithf
|
||||
"Cannot concretize type reference to open generic type %s.%s - it has %d generic parameters"
|
||||
typeInfo.Namespace
|
||||
typeInfo.Name
|
||||
typeInfo.Generics.Length
|
||||
|
||||
// Create or find the concrete type
|
||||
concretizeTypeDefinition ctx targetAssy.Name (ComparableTypeDefinitionHandle.Make typeInfo.TypeDefHandle)
|
||||
|
||||
/// Concretize a type in a specific generic context
|
||||
let rec concretizeType
|
||||
(ctx : ConcretizationContext)
|
||||
(loadAssembly :
|
||||
AssemblyName -> AssemblyReferenceHandle -> (ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly))
|
||||
(assembly : AssemblyName)
|
||||
(typeGenerics : ConcreteTypeHandle ImmutableArray)
|
||||
(methodGenerics : ConcreteTypeHandle ImmutableArray)
|
||||
(typeDefn : TypeDefn)
|
||||
: ConcreteTypeHandle * ConcretizationContext
|
||||
=
|
||||
|
||||
let key = (assembly, typeDefn)
|
||||
|
||||
// Check if we're already processing this type (cycle detection)
|
||||
match ctx.InProgress.TryGetValue key with
|
||||
| true, handle -> handle, ctx
|
||||
| false, _ ->
|
||||
|
||||
match typeDefn with
|
||||
| TypeDefn.PrimitiveType prim -> concretizePrimitive ctx prim
|
||||
|
||||
| TypeDefn.Array (elementType, shape) ->
|
||||
let elementHandle, ctx =
|
||||
concretizeType ctx loadAssembly assembly typeGenerics methodGenerics elementType
|
||||
|
||||
concretizeArray ctx elementHandle shape
|
||||
|
||||
| TypeDefn.OneDimensionalArrayLowerBoundZero elementType ->
|
||||
let elementHandle, ctx =
|
||||
concretizeType ctx loadAssembly assembly typeGenerics methodGenerics elementType
|
||||
|
||||
concretizeOneDimArray ctx elementHandle
|
||||
|
||||
| TypeDefn.GenericTypeParameter index ->
|
||||
if index < typeGenerics.Length then
|
||||
typeGenerics.[index], ctx
|
||||
else
|
||||
failwithf "Generic type parameter %d out of range" index
|
||||
|
||||
| TypeDefn.GenericMethodParameter index ->
|
||||
if index < methodGenerics.Length then
|
||||
methodGenerics.[index], ctx
|
||||
else
|
||||
failwithf "Generic method parameter %d out of range" index
|
||||
|
||||
| TypeDefn.GenericInstantiation (genericDef, args) ->
|
||||
concretizeGenericInstantiation ctx loadAssembly assembly typeGenerics methodGenerics genericDef args
|
||||
|
||||
| TypeDefn.FromDefinition (typeDefHandle, targetAssembly, _) ->
|
||||
concretizeTypeDefinition ctx (AssemblyName targetAssembly) typeDefHandle
|
||||
|
||||
| TypeDefn.FromReference (typeRef, _) -> concretizeTypeReference loadAssembly ctx assembly typeRef
|
||||
|
||||
| TypeDefn.Byref elementType ->
|
||||
// Byref types are managed references to other types
|
||||
// First concretize the element type
|
||||
let elementHandle, ctx =
|
||||
concretizeType ctx loadAssembly assembly typeGenerics methodGenerics elementType
|
||||
|
||||
// Return a Byref constructor wrapping the element type
|
||||
ConcreteTypeHandle.Byref elementHandle, ctx
|
||||
|
||||
| TypeDefn.Pointer elementType ->
|
||||
// Pointer types are unmanaged pointers to other types
|
||||
// First concretize the element type
|
||||
let elementHandle, ctx =
|
||||
concretizeType ctx loadAssembly assembly typeGenerics methodGenerics elementType
|
||||
|
||||
// Return a Pointer constructor wrapping the element type
|
||||
ConcreteTypeHandle.Pointer elementHandle, ctx
|
||||
|
||||
| TypeDefn.Void ->
|
||||
// Void isn't a real runtime type, but we assign it a concretization entry anyway
|
||||
// Use System.Void from the base class types
|
||||
let voidTypeInfo = ctx.BaseTypes.Void
|
||||
|
||||
match
|
||||
findExistingType ctx.ConcreteTypes voidTypeInfo.Assembly voidTypeInfo.Namespace voidTypeInfo.Name []
|
||||
with
|
||||
| Some handle -> handle, ctx
|
||||
| None ->
|
||||
// Create and add the concrete Void type
|
||||
createAndAddConcreteType
|
||||
ctx
|
||||
voidTypeInfo.Assembly
|
||||
(ComparableTypeDefinitionHandle.Make voidTypeInfo.TypeDefHandle)
|
||||
voidTypeInfo.Namespace
|
||||
voidTypeInfo.Name
|
||||
[] // Void has no generic parameters
|
||||
|
||||
| _ -> failwithf "TODO: Concretization of %A not implemented" typeDefn
|
||||
|
||||
and private concretizeGenericInstantiation
|
||||
(ctx : ConcretizationContext)
|
||||
(loadAssembly :
|
||||
AssemblyName -> AssemblyReferenceHandle -> (ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly))
|
||||
(assembly : AssemblyName)
|
||||
(typeGenerics : ConcreteTypeHandle ImmutableArray)
|
||||
(methodGenerics : ConcreteTypeHandle ImmutableArray)
|
||||
(genericDef : TypeDefn)
|
||||
(args : ImmutableArray<TypeDefn>)
|
||||
: ConcreteTypeHandle * ConcretizationContext
|
||||
=
|
||||
// First, concretize all type arguments
|
||||
let argHandles, ctxAfterArgs =
|
||||
args
|
||||
|> Seq.fold
|
||||
(fun (handles, ctx) arg ->
|
||||
let handle, ctx =
|
||||
concretizeType ctx loadAssembly assembly typeGenerics methodGenerics arg
|
||||
|
||||
handle :: handles, ctx
|
||||
)
|
||||
([], ctx)
|
||||
|
||||
let argHandles = argHandles |> List.rev
|
||||
|
||||
// Get the base type definition
|
||||
let baseAssembly, baseTypeDefHandle, baseNamespace, baseName, ctxAfterArgs =
|
||||
match genericDef with
|
||||
| FromDefinition (handle, assy, _) ->
|
||||
// Look up the type definition to get namespace and name
|
||||
let currentAssy = ctxAfterArgs.LoadedAssemblies.[AssemblyName(assy).FullName]
|
||||
let typeDef = currentAssy.TypeDefs.[handle.Get]
|
||||
AssemblyName assy, handle, typeDef.Namespace, typeDef.Name, ctxAfterArgs
|
||||
| FromReference (typeRef, _) ->
|
||||
// For a type reference, we need to find where the type is defined
|
||||
// We're looking for the generic type definition, not an instantiation
|
||||
let currentAssy = ctxAfterArgs.LoadedAssemblies.[assembly.FullName]
|
||||
|
||||
// Helper to find the type definition without instantiating generics
|
||||
let rec findTypeDefinition (assy : DumpedAssembly) (ns : string) (name : string) =
|
||||
// First check if it's defined in this assembly
|
||||
match assy.TypeDef ns name with
|
||||
| Some typeDef -> Some (assy, typeDef)
|
||||
| None ->
|
||||
// Check if it's exported/forwarded
|
||||
match assy.ExportedType (Some ns) name with
|
||||
| Some export ->
|
||||
match export.Data with
|
||||
| NonForwarded _ -> None // Shouldn't happen
|
||||
| ForwardsTo assyRef ->
|
||||
let forwardedAssy = assy.AssemblyReferences.[assyRef]
|
||||
|
||||
match ctxAfterArgs.LoadedAssemblies.TryGetValue forwardedAssy.Name.FullName with
|
||||
| true, targetAssy -> findTypeDefinition targetAssy ns name
|
||||
| false, _ -> None // Assembly not loaded yet
|
||||
| None -> None
|
||||
|
||||
// First try to resolve without loading new assemblies
|
||||
match typeRef.ResolutionScope with
|
||||
| TypeRefResolutionScope.Assembly assyRef ->
|
||||
let targetAssyRef = currentAssy.AssemblyReferences.[assyRef]
|
||||
let targetAssyName = targetAssyRef.Name
|
||||
|
||||
match ctxAfterArgs.LoadedAssemblies.TryGetValue targetAssyName.FullName with
|
||||
| true, targetAssy ->
|
||||
// Try to find the type
|
||||
match findTypeDefinition targetAssy typeRef.Namespace typeRef.Name with
|
||||
| Some (foundAssy, typeDef) ->
|
||||
foundAssy.Name,
|
||||
ComparableTypeDefinitionHandle.Make typeDef.TypeDefHandle,
|
||||
typeDef.Namespace,
|
||||
typeDef.Name,
|
||||
ctxAfterArgs
|
||||
| None ->
|
||||
failwithf
|
||||
"Type %s.%s not found in assembly %s or its forwards"
|
||||
typeRef.Namespace
|
||||
typeRef.Name
|
||||
targetAssyName.FullName
|
||||
|
||||
| false, _ ->
|
||||
// Need to load the assembly
|
||||
let newAssemblies, loadedAssy = loadAssembly assembly assyRef
|
||||
|
||||
let ctxWithNewAssy =
|
||||
{ ctxAfterArgs with
|
||||
LoadedAssemblies = newAssemblies
|
||||
}
|
||||
|
||||
// Now try to find the type in the loaded assembly
|
||||
match findTypeDefinition loadedAssy typeRef.Namespace typeRef.Name with
|
||||
| Some (foundAssy, typeDef) ->
|
||||
foundAssy.Name,
|
||||
ComparableTypeDefinitionHandle.Make typeDef.TypeDefHandle,
|
||||
typeDef.Namespace,
|
||||
typeDef.Name,
|
||||
ctxWithNewAssy
|
||||
| None ->
|
||||
failwithf
|
||||
"Type %s.%s not found in loaded assembly %s or its forwards"
|
||||
typeRef.Namespace
|
||||
typeRef.Name
|
||||
loadedAssy.Name.FullName
|
||||
|
||||
| _ -> failwith "TODO: handle other resolution scopes for type refs in generic instantiation"
|
||||
| _ -> failwithf "Generic instantiation of %A not supported" genericDef
|
||||
|
||||
// Check if this exact generic instantiation already exists
|
||||
match findExistingType ctxAfterArgs.ConcreteTypes baseAssembly baseNamespace baseName argHandles with
|
||||
| Some existingHandle ->
|
||||
// Type already exists, return it
|
||||
existingHandle, ctxAfterArgs
|
||||
| None ->
|
||||
// Need to handle cycles: check if we're already processing this type
|
||||
let typeDefnKey = (assembly, GenericInstantiation (genericDef, args))
|
||||
|
||||
match ctxAfterArgs.InProgress.TryGetValue typeDefnKey with
|
||||
| true, handle ->
|
||||
// We're in a cycle, return the in-progress handle
|
||||
handle, ctxAfterArgs
|
||||
| false, _ ->
|
||||
// Pre-allocate a handle for this type to handle cycles
|
||||
let tempId = ctxAfterArgs.ConcreteTypes.NextHandle
|
||||
let tempHandle = ConcreteTypeHandle.Concrete tempId
|
||||
|
||||
// Create the concrete type
|
||||
let concreteType =
|
||||
{
|
||||
_AssemblyName = baseAssembly
|
||||
_Definition = baseTypeDefHandle
|
||||
_Namespace = baseNamespace
|
||||
_Name = baseName
|
||||
_Generics = argHandles
|
||||
}
|
||||
|
||||
// Add to the concrete types and mark as in progress
|
||||
let newCtx =
|
||||
{ ctxAfterArgs with
|
||||
ConcreteTypes =
|
||||
{ ctxAfterArgs.ConcreteTypes with
|
||||
NextHandle = ctxAfterArgs.ConcreteTypes.NextHandle + 1
|
||||
Mapping = ctxAfterArgs.ConcreteTypes.Mapping |> Map.add tempId concreteType
|
||||
}
|
||||
InProgress = ctxAfterArgs.InProgress.SetItem (typeDefnKey, tempHandle)
|
||||
}
|
||||
|
||||
// Remove from in-progress when done
|
||||
let finalCtx =
|
||||
{ newCtx with
|
||||
InProgress = newCtx.InProgress.Remove typeDefnKey
|
||||
}
|
||||
|
||||
tempHandle, finalCtx
|
||||
|
||||
/// High-level API for concretizing types
|
||||
[<RequireQualifiedAccess>]
|
||||
module Concretization =
|
||||
|
||||
/// Helper to concretize an array of types
|
||||
let private concretizeTypeArray
|
||||
(ctx : TypeConcretization.ConcretizationContext)
|
||||
(loadAssembly :
|
||||
AssemblyName -> AssemblyReferenceHandle -> (ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly))
|
||||
(assembly : AssemblyName)
|
||||
(typeArgs : ConcreteTypeHandle ImmutableArray)
|
||||
(methodArgs : ConcreteTypeHandle ImmutableArray)
|
||||
(types : ImmutableArray<TypeDefn>)
|
||||
: ImmutableArray<ConcreteTypeHandle> * TypeConcretization.ConcretizationContext
|
||||
=
|
||||
|
||||
let handles = ImmutableArray.CreateBuilder (types.Length)
|
||||
let mutable ctx = ctx
|
||||
|
||||
for i = 0 to types.Length - 1 do
|
||||
let handle, newCtx =
|
||||
TypeConcretization.concretizeType ctx loadAssembly assembly typeArgs methodArgs types.[i]
|
||||
|
||||
handles.Add handle
|
||||
ctx <- newCtx
|
||||
|
||||
handles.ToImmutable (), ctx
|
||||
|
||||
/// Helper to concretize a method signature
|
||||
let private concretizeMethodSignature
|
||||
(ctx : TypeConcretization.ConcretizationContext)
|
||||
(loadAssembly :
|
||||
AssemblyName -> AssemblyReferenceHandle -> (ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly))
|
||||
(assembly : AssemblyName)
|
||||
(typeArgs : ConcreteTypeHandle ImmutableArray)
|
||||
(methodArgs : ConcreteTypeHandle ImmutableArray)
|
||||
(signature : TypeMethodSignature<TypeDefn>)
|
||||
: TypeMethodSignature<ConcreteTypeHandle> * TypeConcretization.ConcretizationContext
|
||||
=
|
||||
|
||||
// Concretize return type
|
||||
let returnHandle, ctx =
|
||||
TypeConcretization.concretizeType ctx loadAssembly assembly typeArgs methodArgs signature.ReturnType
|
||||
|
||||
// Concretize parameter types
|
||||
let paramHandles = ResizeArray<ConcreteTypeHandle> ()
|
||||
let mutable ctx = ctx
|
||||
|
||||
for paramType in signature.ParameterTypes do
|
||||
let handle, newCtx =
|
||||
TypeConcretization.concretizeType ctx loadAssembly assembly typeArgs methodArgs paramType
|
||||
|
||||
paramHandles.Add (handle)
|
||||
ctx <- newCtx
|
||||
|
||||
let newSignature =
|
||||
{
|
||||
Header = signature.Header
|
||||
ReturnType = returnHandle
|
||||
ParameterTypes = paramHandles |> Seq.toList
|
||||
GenericParameterCount = signature.GenericParameterCount
|
||||
RequiredParameterCount = signature.RequiredParameterCount
|
||||
}
|
||||
|
||||
newSignature, ctx
|
||||
|
||||
/// Helper to ensure base type assembly is loaded
|
||||
let rec private ensureBaseTypeAssembliesLoaded
|
||||
(loadAssembly :
|
||||
AssemblyName -> AssemblyReferenceHandle -> (ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly))
|
||||
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||
(assyName : AssemblyName)
|
||||
(baseTypeInfo : BaseTypeInfo option)
|
||||
: ImmutableDictionary<string, DumpedAssembly>
|
||||
=
|
||||
match baseTypeInfo with
|
||||
| None -> assemblies
|
||||
| Some (BaseTypeInfo.TypeRef r) ->
|
||||
let assy = assemblies.[assyName.FullName]
|
||||
let typeRef = assy.TypeRefs.[r]
|
||||
|
||||
match typeRef.ResolutionScope with
|
||||
| TypeRefResolutionScope.Assembly assyRef ->
|
||||
let targetAssyRef = assy.AssemblyReferences.[assyRef]
|
||||
|
||||
match assemblies.TryGetValue targetAssyRef.Name.FullName with
|
||||
| true, _ -> assemblies
|
||||
| false, _ ->
|
||||
// Need to load the assembly - pass the assembly that contains the reference
|
||||
let newAssemblies, _ = loadAssembly assy.Name assyRef
|
||||
newAssemblies
|
||||
| _ -> assemblies
|
||||
| Some (BaseTypeInfo.TypeDef _)
|
||||
| Some (BaseTypeInfo.ForeignAssemblyType _)
|
||||
| Some (BaseTypeInfo.TypeSpec _) -> assemblies
|
||||
|
||||
/// Concretize a method's signature and body
|
||||
let concretizeMethod
|
||||
(ctx : AllConcreteTypes)
|
||||
(loadAssembly :
|
||||
AssemblyName -> AssemblyReferenceHandle -> (ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly))
|
||||
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||
(baseTypes : BaseClassTypes<DumpedAssembly>)
|
||||
(method : WoofWare.PawPrint.MethodInfo<TypeDefn, WoofWare.PawPrint.GenericParameter, TypeDefn>)
|
||||
(typeArgs : ConcreteTypeHandle ImmutableArray)
|
||||
(methodArgs : ConcreteTypeHandle ImmutableArray)
|
||||
: WoofWare.PawPrint.MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle> *
|
||||
AllConcreteTypes *
|
||||
ImmutableDictionary<string, DumpedAssembly>
|
||||
=
|
||||
|
||||
// Ensure base type assemblies are loaded for the declaring type
|
||||
let assemblies =
|
||||
let assy = assemblies.[method.DeclaringType._AssemblyName.FullName]
|
||||
let typeDef = assy.TypeDefs.[method.DeclaringType._Definition.Get]
|
||||
ensureBaseTypeAssembliesLoaded loadAssembly assemblies assy.Name typeDef.BaseType
|
||||
|
||||
let concCtx =
|
||||
{
|
||||
TypeConcretization.ConcretizationContext.InProgress = ImmutableDictionary.Empty
|
||||
TypeConcretization.ConcretizationContext.ConcreteTypes = ctx
|
||||
TypeConcretization.ConcretizationContext.LoadedAssemblies = assemblies
|
||||
TypeConcretization.ConcretizationContext.BaseTypes = baseTypes
|
||||
}
|
||||
|
||||
// First, we need to create a TypeDefn for the declaring type with its generics instantiated
|
||||
let declaringTypeDefn =
|
||||
if method.DeclaringType._Generics.IsEmpty then
|
||||
// Non-generic type - determine the SignatureTypeKind
|
||||
let assy = concCtx.LoadedAssemblies.[method.DeclaringType._AssemblyName.FullName]
|
||||
let arg = assy.TypeDefs.[method.DeclaringType._Definition.Get]
|
||||
|
||||
let baseType =
|
||||
arg.BaseType
|
||||
|> DumpedAssembly.resolveBaseType baseTypes concCtx.LoadedAssemblies assy.Name
|
||||
|
||||
let signatureTypeKind =
|
||||
match baseType with
|
||||
| ResolvedBaseType.Enum
|
||||
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
|
||||
| ResolvedBaseType.Object
|
||||
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
|
||||
|
||||
TypeDefn.FromDefinition (
|
||||
method.DeclaringType._Definition,
|
||||
method.DeclaringType._AssemblyName.FullName,
|
||||
signatureTypeKind
|
||||
)
|
||||
else
|
||||
// Generic type - create a GenericInstantiation
|
||||
let assy = concCtx.LoadedAssemblies.[method.DeclaringType._AssemblyName.FullName]
|
||||
let arg = assy.TypeDefs.[method.DeclaringType._Definition.Get]
|
||||
|
||||
let baseTypeResolved =
|
||||
arg.BaseType
|
||||
|> DumpedAssembly.resolveBaseType baseTypes concCtx.LoadedAssemblies assy.Name
|
||||
|
||||
let signatureTypeKind =
|
||||
match baseTypeResolved with
|
||||
| ResolvedBaseType.Enum
|
||||
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
|
||||
| ResolvedBaseType.Object
|
||||
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
|
||||
|
||||
let baseType =
|
||||
TypeDefn.FromDefinition (
|
||||
method.DeclaringType._Definition,
|
||||
method.DeclaringType._AssemblyName.FullName,
|
||||
signatureTypeKind
|
||||
)
|
||||
|
||||
let genericArgsLength = method.DeclaringType.Generics.Length
|
||||
|
||||
if genericArgsLength > typeArgs.Length then
|
||||
failwithf
|
||||
"Method declaring type expects %d generic arguments but only %d provided"
|
||||
genericArgsLength
|
||||
typeArgs.Length
|
||||
|
||||
let genericArgs =
|
||||
typeArgs.Slice (0, genericArgsLength)
|
||||
|> Seq.mapi (fun i _ -> TypeDefn.GenericTypeParameter i)
|
||||
|> ImmutableArray.CreateRange
|
||||
|
||||
TypeDefn.GenericInstantiation (baseType, genericArgs)
|
||||
|
||||
// Concretize the declaring type
|
||||
let declaringHandle, concCtx =
|
||||
TypeConcretization.concretizeType
|
||||
concCtx
|
||||
loadAssembly
|
||||
method.DeclaringType._AssemblyName
|
||||
typeArgs
|
||||
methodArgs
|
||||
declaringTypeDefn
|
||||
|
||||
// Look up the concretized declaring type
|
||||
let concretizedDeclaringType =
|
||||
AllConcreteTypes.lookup declaringHandle concCtx.ConcreteTypes |> Option.get
|
||||
|
||||
// Concretize signature
|
||||
let signature, concCtx =
|
||||
concretizeMethodSignature
|
||||
concCtx
|
||||
loadAssembly
|
||||
method.DeclaringType._AssemblyName
|
||||
typeArgs
|
||||
methodArgs
|
||||
method.Signature
|
||||
|
||||
// Concretize local variables
|
||||
let instructions, concCtx2 =
|
||||
match method.Instructions with
|
||||
| None -> None, concCtx
|
||||
| Some instr ->
|
||||
let locals, updatedCtx =
|
||||
match instr.LocalVars with
|
||||
| None -> None, concCtx
|
||||
| Some vars ->
|
||||
let handles, ctx =
|
||||
concretizeTypeArray
|
||||
concCtx
|
||||
loadAssembly
|
||||
method.DeclaringType._AssemblyName
|
||||
typeArgs
|
||||
methodArgs
|
||||
vars
|
||||
|
||||
Some handles, ctx
|
||||
|
||||
Some (MethodInstructions.setLocalVars locals instr), updatedCtx
|
||||
|
||||
// Map generics to handles
|
||||
let genericHandles =
|
||||
method.Generics
|
||||
|> Seq.mapi (fun i _ -> methodArgs.[i])
|
||||
|> ImmutableArray.CreateRange
|
||||
|
||||
let concretizedMethod : MethodInfo<_, _, ConcreteTypeHandle> =
|
||||
{
|
||||
DeclaringType = concretizedDeclaringType
|
||||
Handle = method.Handle
|
||||
Name = method.Name
|
||||
Instructions = instructions
|
||||
Parameters = method.Parameters
|
||||
Generics = genericHandles
|
||||
Signature = signature
|
||||
RawSignature = method.RawSignature
|
||||
CustomAttributes = method.CustomAttributes
|
||||
MethodAttributes = method.MethodAttributes
|
||||
ImplAttributes = method.ImplAttributes
|
||||
IsStatic = method.IsStatic
|
||||
}
|
||||
|
||||
concretizedMethod, concCtx2.ConcreteTypes, concCtx2.LoadedAssemblies
|
||||
|
||||
let rec concreteHandleToTypeDefn
|
||||
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
|
||||
(handle : ConcreteTypeHandle)
|
||||
(concreteTypes : AllConcreteTypes)
|
||||
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||
: TypeDefn
|
||||
=
|
||||
match handle with
|
||||
| ConcreteTypeHandle.Byref elementHandle ->
|
||||
let elementType =
|
||||
concreteHandleToTypeDefn baseClassTypes elementHandle concreteTypes assemblies
|
||||
|
||||
TypeDefn.Byref elementType
|
||||
| ConcreteTypeHandle.Pointer elementHandle ->
|
||||
let elementType =
|
||||
concreteHandleToTypeDefn baseClassTypes elementHandle concreteTypes assemblies
|
||||
|
||||
TypeDefn.Pointer elementType
|
||||
| ConcreteTypeHandle.Concrete _ ->
|
||||
match AllConcreteTypes.lookup handle concreteTypes with
|
||||
| None -> failwith "Logic error: handle not found"
|
||||
| Some concreteType ->
|
||||
|
||||
// Determine SignatureTypeKind
|
||||
let assy = assemblies.[concreteType.Assembly.FullName]
|
||||
let typeDef = assy.TypeDefs.[concreteType.Definition.Get]
|
||||
// Determine SignatureTypeKind from base type
|
||||
let baseType =
|
||||
typeDef.BaseType
|
||||
|> DumpedAssembly.resolveBaseType baseClassTypes assemblies assy.Name
|
||||
|
||||
let signatureTypeKind =
|
||||
match baseType with
|
||||
| ResolvedBaseType.Enum
|
||||
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
|
||||
| ResolvedBaseType.Object
|
||||
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
|
||||
|
||||
if concreteType.Generics.IsEmpty then
|
||||
TypeDefn.FromDefinition (concreteType.Definition, concreteType.Assembly.FullName, signatureTypeKind)
|
||||
else
|
||||
// Recursively convert generic arguments
|
||||
let genericArgs =
|
||||
concreteType.Generics
|
||||
|> List.map (fun h -> concreteHandleToTypeDefn baseClassTypes h concreteTypes assemblies)
|
||||
|> ImmutableArray.CreateRange
|
||||
|
||||
let baseDef =
|
||||
TypeDefn.FromDefinition (concreteType.Definition, concreteType.Assembly.FullName, signatureTypeKind)
|
||||
|
||||
TypeDefn.GenericInstantiation (baseDef, genericArgs)
|
@@ -26,6 +26,7 @@
|
||||
<Compile Include="ExportedType.fs" />
|
||||
<Compile Include="TypeSpec.fs" />
|
||||
<Compile Include="Assembly.fs" />
|
||||
<Compile Include="TypeConcretisation.fs" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
|
@@ -16,6 +16,18 @@ module TestPureCases =
|
||||
|
||||
let unimplemented =
|
||||
[
|
||||
{
|
||||
FileName = "CrossAssemblyTypes.cs"
|
||||
ExpectedReturnCode = 0
|
||||
NativeImpls = MockEnv.make ()
|
||||
LocalVariablesOfMain = None
|
||||
}
|
||||
{
|
||||
FileName = "GenericEdgeCases.cs"
|
||||
ExpectedReturnCode = 0
|
||||
NativeImpls = MockEnv.make ()
|
||||
LocalVariablesOfMain = None
|
||||
}
|
||||
{
|
||||
FileName = "TestShl.cs"
|
||||
ExpectedReturnCode = 0
|
||||
@@ -80,6 +92,12 @@ module TestPureCases =
|
||||
NativeImpls = MockEnv.make ()
|
||||
LocalVariablesOfMain = [ CliType.Numeric (CliNumericType.Int32 1) ] |> Some
|
||||
}
|
||||
{
|
||||
FileName = "StaticVariables.cs"
|
||||
ExpectedReturnCode = 0
|
||||
NativeImpls = MockEnv.make ()
|
||||
LocalVariablesOfMain = None
|
||||
}
|
||||
{
|
||||
FileName = "Ldind.cs"
|
||||
ExpectedReturnCode = 0
|
||||
@@ -200,6 +218,12 @@ module TestPureCases =
|
||||
NativeImpls = MockEnv.make ()
|
||||
LocalVariablesOfMain = None
|
||||
}
|
||||
{
|
||||
FileName = "TypeConcretization.cs"
|
||||
ExpectedReturnCode = 0
|
||||
NativeImpls = MockEnv.make ()
|
||||
LocalVariablesOfMain = None
|
||||
}
|
||||
{
|
||||
FileName = "TestOr.cs"
|
||||
ExpectedReturnCode = 0
|
||||
|
@@ -22,6 +22,7 @@
|
||||
<EmbeddedResource Include="sourcesPure\BasicLock.cs" />
|
||||
<EmbeddedResource Include="sourcesPure\Floats.cs" />
|
||||
<EmbeddedResource Include="sourcesPure\NoOp.cs" />
|
||||
<EmbeddedResource Include="sourcesPure\StaticVariables.cs" />
|
||||
<EmbeddedResource Include="sourcesPure\Ldelema.cs" />
|
||||
<EmbeddedResource Include="sourcesPure\ExceptionWithNoOpCatch.cs" />
|
||||
<EmbeddedResource Include="sourcesPure\ExceptionWithNoOpFinally.cs" />
|
||||
@@ -36,6 +37,9 @@
|
||||
<EmbeddedResource Include="sourcesPure\TestOr.cs" />
|
||||
<EmbeddedResource Include="sourcesPure\CustomDelegate.cs" />
|
||||
<EmbeddedResource Include="sourcesPure\Ldind.cs" />
|
||||
<EmbeddedResource Include="sourcesPure\TypeConcretization.cs" />
|
||||
<EmbeddedResource Include="sourcesPure\CrossAssemblyTypes.cs" />
|
||||
<EmbeddedResource Include="sourcesPure\GenericEdgeCases.cs" />
|
||||
</ItemGroup>
|
||||
<ItemGroup>
|
||||
<EmbeddedResource Include="sourcesImpure\WriteLine.cs" />
|
||||
|
120
WoofWare.PawPrint.Test/sourcesPure/CrossAssemblyTypes.cs
Normal file
120
WoofWare.PawPrint.Test/sourcesPure/CrossAssemblyTypes.cs
Normal file
@@ -0,0 +1,120 @@
|
||||
using System;
|
||||
using System.Collections.Generic;
|
||||
using System.Collections;
|
||||
|
||||
// Test cross-assembly type resolution using standard library types
|
||||
public class CrossAssemblyTypeTest
|
||||
{
|
||||
public static int TestSystemTypes()
|
||||
{
|
||||
// Test various System types to ensure proper assembly resolution
|
||||
|
||||
// System.DateTime
|
||||
var date = new DateTime(2023, 1, 1);
|
||||
if (date.Year != 2023) return 1;
|
||||
|
||||
// System.Guid
|
||||
var guid = Guid.Empty;
|
||||
if (guid != Guid.Empty) return 2;
|
||||
|
||||
// System.TimeSpan
|
||||
var timeSpan = TimeSpan.FromMinutes(30);
|
||||
if (timeSpan.TotalMinutes != 30) return 3;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
public static int TestCollectionTypes()
|
||||
{
|
||||
// Test various collection types from different assemblies
|
||||
|
||||
// Dictionary<TKey, TValue>
|
||||
var dict = new Dictionary<string, int>();
|
||||
dict["test"] = 42;
|
||||
if (dict["test"] != 42) return 1;
|
||||
|
||||
// HashSet<T>
|
||||
var hashSet = new HashSet<int>();
|
||||
hashSet.Add(1);
|
||||
hashSet.Add(2);
|
||||
hashSet.Add(1); // duplicate
|
||||
if (hashSet.Count != 2) return 2;
|
||||
|
||||
// Queue<T>
|
||||
var queue = new Queue<string>();
|
||||
queue.Enqueue("first");
|
||||
queue.Enqueue("second");
|
||||
if (queue.Dequeue() != "first") return 3;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
public static int TestGenericInterfaces()
|
||||
{
|
||||
// Test generic interfaces across assemblies
|
||||
|
||||
var list = new List<int> { 1, 2, 3 };
|
||||
|
||||
// IEnumerable<T>
|
||||
IEnumerable<int> enumerable = list;
|
||||
int count = 0;
|
||||
foreach (int item in enumerable)
|
||||
{
|
||||
count++;
|
||||
}
|
||||
if (count != 3) return 1;
|
||||
|
||||
// ICollection<T>
|
||||
ICollection<int> collection = list;
|
||||
if (collection.Count != 3) return 2;
|
||||
|
||||
// IList<T>
|
||||
IList<int> ilist = list;
|
||||
if (ilist[0] != 1) return 3;
|
||||
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
// Test Array.Empty<T> which was mentioned in the diff as a specific case
|
||||
public class ArrayEmptyTest
|
||||
{
|
||||
public static int TestArrayEmpty()
|
||||
{
|
||||
// Test Array.Empty<T> for different types
|
||||
var emptyInts = Array.Empty<int>();
|
||||
var emptyStrings = Array.Empty<string>();
|
||||
|
||||
if (emptyInts.Length != 0) return 1;
|
||||
if (emptyStrings.Length != 0) return 2;
|
||||
|
||||
// Verify they are different instances for different types
|
||||
// but same instance for same type
|
||||
var emptyInts2 = Array.Empty<int>();
|
||||
if (!ReferenceEquals(emptyInts, emptyInts2)) return 3;
|
||||
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
class Program
|
||||
{
|
||||
static int Main(string[] args)
|
||||
{
|
||||
int result;
|
||||
|
||||
result = CrossAssemblyTypeTest.TestSystemTypes();
|
||||
if (result != 0) return 100 + result;
|
||||
|
||||
result = CrossAssemblyTypeTest.TestCollectionTypes();
|
||||
if (result != 0) return 200 + result;
|
||||
|
||||
result = CrossAssemblyTypeTest.TestGenericInterfaces();
|
||||
if (result != 0) return 300 + result;
|
||||
|
||||
result = ArrayEmptyTest.TestArrayEmpty();
|
||||
if (result != 0) return 400 + result;
|
||||
|
||||
return 0; // All tests passed
|
||||
}
|
||||
}
|
142
WoofWare.PawPrint.Test/sourcesPure/GenericEdgeCases.cs
Normal file
142
WoofWare.PawPrint.Test/sourcesPure/GenericEdgeCases.cs
Normal file
@@ -0,0 +1,142 @@
|
||||
using System;
|
||||
using System.Collections.Generic;
|
||||
|
||||
// Test edge cases with generic parameters as mentioned in the diff
|
||||
public class GenericParameterEdgeCases
|
||||
{
|
||||
// Test method with multiple generic parameters
|
||||
public static T2 Convert<T1, T2>(T1 input, Func<T1, T2> converter)
|
||||
{
|
||||
return converter(input);
|
||||
}
|
||||
|
||||
// Test nested generic method calls
|
||||
public static List<T> WrapInList<T>(T item)
|
||||
{
|
||||
var list = new List<T>();
|
||||
list.Add(item);
|
||||
return list;
|
||||
}
|
||||
|
||||
public static int TestMultipleGenericParameters()
|
||||
{
|
||||
// Test Convert method with different type combinations
|
||||
string result1 = Convert<int, string>(42, x => x.ToString());
|
||||
if (result1 != "42") return 1;
|
||||
|
||||
int result2 = Convert<string, int>("123", x => int.Parse(x));
|
||||
if (result2 != 123) return 2;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
public static int TestNestedGenericMethodCalls()
|
||||
{
|
||||
// Test calling generic method from within another generic method
|
||||
var intList = WrapInList<int>(42);
|
||||
if (intList.Count != 1) return 1;
|
||||
if (intList[0] != 42) return 2;
|
||||
|
||||
var stringList = WrapInList<string>("test");
|
||||
if (stringList.Count != 1) return 3;
|
||||
if (stringList[0] != "test") return 4;
|
||||
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
// Test deeply nested generic types
|
||||
public class DeepNestingTest
|
||||
{
|
||||
public static int TestDeeplyNestedGenerics()
|
||||
{
|
||||
// Test Dictionary<string, List<Dictionary<int, string>>>
|
||||
var complexType = new Dictionary<string, List<Dictionary<int, string>>>();
|
||||
|
||||
var innerDict = new Dictionary<int, string>();
|
||||
innerDict[1] = "one";
|
||||
innerDict[2] = "two";
|
||||
|
||||
var listOfDicts = new List<Dictionary<int, string>>();
|
||||
listOfDicts.Add(innerDict);
|
||||
|
||||
complexType["test"] = listOfDicts;
|
||||
|
||||
if (complexType["test"].Count != 1) return 1;
|
||||
if (complexType["test"][0][1] != "one") return 2;
|
||||
if (complexType["test"][0][2] != "two") return 3;
|
||||
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
// Test generic constraints and inheritance scenarios
|
||||
public class GenericConstraintTest<T> where T : class
|
||||
{
|
||||
private T value;
|
||||
|
||||
public GenericConstraintTest(T val)
|
||||
{
|
||||
value = val;
|
||||
}
|
||||
|
||||
public bool IsNull()
|
||||
{
|
||||
return value == null;
|
||||
}
|
||||
|
||||
public static int TestGenericConstraints()
|
||||
{
|
||||
var test = new GenericConstraintTest<string>("hello");
|
||||
if (test.IsNull()) return 1;
|
||||
|
||||
var nullTest = new GenericConstraintTest<string>(null);
|
||||
if (!nullTest.IsNull()) return 2;
|
||||
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
// Test generic field access scenarios mentioned in the diff
|
||||
public class GenericFieldAccess<T>
|
||||
{
|
||||
public static T DefaultValue = default(T);
|
||||
|
||||
public static int TestStaticGenericField()
|
||||
{
|
||||
// Test that static fields work correctly with generics
|
||||
if (GenericFieldAccess<int>.DefaultValue != 0) return 1;
|
||||
|
||||
// Test that different instantiations have different static fields
|
||||
GenericFieldAccess<int>.DefaultValue = 42;
|
||||
if (GenericFieldAccess<int>.DefaultValue != 42) return 2;
|
||||
if (GenericFieldAccess<string>.DefaultValue != null) return 3;
|
||||
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
class Program
|
||||
{
|
||||
static int Main(string[] args)
|
||||
{
|
||||
int result;
|
||||
|
||||
result = GenericParameterEdgeCases.TestMultipleGenericParameters();
|
||||
if (result != 0) return 100 + result;
|
||||
|
||||
result = GenericParameterEdgeCases.TestNestedGenericMethodCalls();
|
||||
if (result != 0) return 200 + result;
|
||||
|
||||
result = DeepNestingTest.TestDeeplyNestedGenerics();
|
||||
if (result != 0) return 300 + result;
|
||||
|
||||
result = GenericConstraintTest<string>.TestGenericConstraints();
|
||||
if (result != 0) return 400 + result;
|
||||
|
||||
result = GenericFieldAccess<int>.TestStaticGenericField();
|
||||
if (result != 0) return 500 + result;
|
||||
|
||||
return 0; // All tests passed
|
||||
}
|
||||
}
|
54
WoofWare.PawPrint.Test/sourcesPure/StaticVariables.cs
Normal file
54
WoofWare.PawPrint.Test/sourcesPure/StaticVariables.cs
Normal file
@@ -0,0 +1,54 @@
|
||||
public class GenericCounter<T>
|
||||
{
|
||||
private static int count = 0;
|
||||
|
||||
public static void Increment()
|
||||
{
|
||||
count++;
|
||||
}
|
||||
|
||||
public static int GetCount()
|
||||
{
|
||||
return count;
|
||||
}
|
||||
|
||||
public static void Reset()
|
||||
{
|
||||
count = 0;
|
||||
}
|
||||
}
|
||||
|
||||
class Program
|
||||
{
|
||||
static int Main(string[] argv)
|
||||
{
|
||||
// Test that different generic instantiations have separate static variables
|
||||
|
||||
// Initial state should be 0 for all
|
||||
if (GenericCounter<int>.GetCount() != 0) return 1;
|
||||
if (GenericCounter<string>.GetCount() != 0) return 2;
|
||||
|
||||
// Increment int version 3 times
|
||||
GenericCounter<int>.Increment();
|
||||
GenericCounter<int>.Increment();
|
||||
GenericCounter<int>.Increment();
|
||||
|
||||
// Increment string version 2 times
|
||||
GenericCounter<string>.Increment();
|
||||
GenericCounter<string>.Increment();
|
||||
|
||||
// Verify counts are independent
|
||||
if (GenericCounter<int>.GetCount() != 3) return 3;
|
||||
if (GenericCounter<string>.GetCount() != 2) return 4;
|
||||
|
||||
// Reset int version only
|
||||
GenericCounter<int>.Reset();
|
||||
|
||||
// Verify reset only affected int version
|
||||
if (GenericCounter<int>.GetCount() != 0) return 5;
|
||||
if (GenericCounter<string>.GetCount() != 2) return 6;
|
||||
|
||||
// Test passes - static variables are isolated per generic instantiation
|
||||
return 0;
|
||||
}
|
||||
}
|
112
WoofWare.PawPrint.Test/sourcesPure/TypeConcretization.cs
Normal file
112
WoofWare.PawPrint.Test/sourcesPure/TypeConcretization.cs
Normal file
@@ -0,0 +1,112 @@
|
||||
using System;
|
||||
using System.Collections.Generic;
|
||||
|
||||
// Test basic type concretization
|
||||
public class BasicTypeTest
|
||||
{
|
||||
public static int TestBasicTypes()
|
||||
{
|
||||
// Test primitive types
|
||||
int i = 42;
|
||||
string s = "hello";
|
||||
bool b = true;
|
||||
|
||||
if (i != 42) return 1;
|
||||
if (s != "hello") return 2;
|
||||
if (!b) return 3;
|
||||
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
// Test generic type instantiation
|
||||
public class GenericTypeTest<T>
|
||||
{
|
||||
private T value;
|
||||
|
||||
public GenericTypeTest(T val)
|
||||
{
|
||||
value = val;
|
||||
}
|
||||
|
||||
public T GetValue()
|
||||
{
|
||||
return value;
|
||||
}
|
||||
|
||||
public static int TestGenericInstantiation()
|
||||
{
|
||||
var intTest = new GenericTypeTest<int>(123);
|
||||
var stringTest = new GenericTypeTest<string>("test");
|
||||
|
||||
if (intTest.GetValue() != 123) return 1;
|
||||
if (stringTest.GetValue() != "test") return 2;
|
||||
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
// Test nested generic types
|
||||
public class NestedGenericTest
|
||||
{
|
||||
public static int TestNestedGenerics()
|
||||
{
|
||||
var listOfInts = new List<int>();
|
||||
listOfInts.Add(1);
|
||||
listOfInts.Add(2);
|
||||
|
||||
if (listOfInts.Count != 2) return 1;
|
||||
if (listOfInts[0] != 1) return 2;
|
||||
if (listOfInts[1] != 2) return 3;
|
||||
|
||||
var listOfLists = new List<List<int>>();
|
||||
listOfLists.Add(listOfInts);
|
||||
|
||||
if (listOfLists.Count != 1) return 4;
|
||||
if (listOfLists[0].Count != 2) return 5;
|
||||
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
// Test generic methods
|
||||
public class GenericMethodTest
|
||||
{
|
||||
public static T Identity<T>(T input)
|
||||
{
|
||||
return input;
|
||||
}
|
||||
|
||||
public static int TestGenericMethods()
|
||||
{
|
||||
int intResult = Identity<int>(42);
|
||||
string stringResult = Identity<string>("hello");
|
||||
|
||||
if (intResult != 42) return 1;
|
||||
if (stringResult != "hello") return 2;
|
||||
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
class Program
|
||||
{
|
||||
static int Main(string[] args)
|
||||
{
|
||||
int result;
|
||||
|
||||
result = BasicTypeTest.TestBasicTypes();
|
||||
if (result != 0) return 100 + result;
|
||||
|
||||
result = GenericTypeTest<int>.TestGenericInstantiation();
|
||||
if (result != 0) return 200 + result;
|
||||
|
||||
result = NestedGenericTest.TestNestedGenerics();
|
||||
if (result != 0) return 300 + result;
|
||||
|
||||
result = GenericMethodTest.TestGenericMethods();
|
||||
if (result != 0) return 400 + result;
|
||||
|
||||
return 0; // All tests passed
|
||||
}
|
||||
}
|
@@ -60,22 +60,18 @@ module AbstractMachine =
|
||||
|
||||
let delegateToRun = state.ManagedHeap.NonArrayObjects.[delegateToRunAddr]
|
||||
|
||||
if delegateToRun.Fields.["_target"] <> CliType.ObjectRef None then
|
||||
failwith "TODO: delegate target wasn't None"
|
||||
let target =
|
||||
match delegateToRun.Fields.["_target"] with
|
||||
| CliType.ObjectRef addr -> addr
|
||||
| x -> failwith $"TODO: delegate target wasn't an object ref: %O{x}"
|
||||
|
||||
let methodPtr =
|
||||
match delegateToRun.Fields.["_methodPtr"] with
|
||||
| CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.FunctionPointer mi)) -> mi
|
||||
| d -> failwith $"unexpectedly not a method pointer in delegate invocation: {d}"
|
||||
|
||||
let typeGenerics =
|
||||
instruction.ExecutingMethod.DeclaringType.Generics |> ImmutableArray.CreateRange
|
||||
|
||||
let methodGenerics = instruction.ExecutingMethod.Generics
|
||||
|
||||
let methodPtr =
|
||||
methodPtr |> MethodInfo.mapTypeGenerics (fun i _ -> typeGenerics.[i])
|
||||
|
||||
// When we return, we need to go back up the stack
|
||||
match state |> IlMachineState.returnStackFrame loggerFactory baseClassTypes thread with
|
||||
| None -> failwith "unexpectedly nowhere to return from delegate"
|
||||
@@ -86,23 +82,41 @@ module AbstractMachine =
|
||||
(state, instruction.Arguments)
|
||||
||> Seq.fold (fun state arg -> IlMachineState.pushToEvalStack arg thread state)
|
||||
|
||||
// The odd little calling convention strikes again: we push the `target` parameter on top of the
|
||||
// stack, although that doesn't actually happen in the CLR.
|
||||
// We'll pretend we're constructing an object, so that the calling convention gets respected in
|
||||
// `callMethod`.
|
||||
let state, constructing =
|
||||
match target with
|
||||
| None -> state, None
|
||||
| Some target ->
|
||||
let state =
|
||||
IlMachineState.pushToEvalStack (CliType.ObjectRef (Some target)) thread state
|
||||
|
||||
state, Some target
|
||||
|
||||
let state, _ =
|
||||
state.WithThreadSwitchedToAssembly methodPtr.DeclaringType.Assembly thread
|
||||
|
||||
// Don't advance the program counter again on return; that was already done by the Callvirt that
|
||||
// caused this delegate to be invoked.
|
||||
let state, result =
|
||||
state
|
||||
|> IlMachineState.callMethodInActiveAssembly
|
||||
let currentThreadState = state.ThreadState.[thread]
|
||||
|
||||
let state =
|
||||
IlMachineState.callMethod
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
thread
|
||||
false
|
||||
(Some methodGenerics)
|
||||
methodPtr
|
||||
None
|
||||
constructing
|
||||
false
|
||||
false
|
||||
methodGenerics
|
||||
methodPtr
|
||||
thread
|
||||
currentThreadState
|
||||
state
|
||||
|
||||
ExecutionResult.Stepped (state, result)
|
||||
ExecutionResult.Stepped (state, WhatWeDid.Executed)
|
||||
| _ ->
|
||||
|
||||
let outcome =
|
||||
@@ -111,8 +125,8 @@ module AbstractMachine =
|
||||
targetType.Namespace,
|
||||
targetType.Name,
|
||||
instruction.ExecutingMethod.Name,
|
||||
instruction.ExecutingMethod.Signature.ParameterTypes,
|
||||
instruction.ExecutingMethod.Signature.ReturnType
|
||||
instruction.ExecutingMethod.RawSignature.ParameterTypes,
|
||||
instruction.ExecutingMethod.RawSignature.ReturnType
|
||||
with
|
||||
| "System.Private.CoreLib",
|
||||
"System",
|
||||
|
@@ -1,6 +1,5 @@
|
||||
namespace WoofWare.PawPrint
|
||||
|
||||
open System
|
||||
open System.Collections.Immutable
|
||||
open System.Reflection
|
||||
open System.Reflection.Metadata
|
||||
@@ -63,7 +62,7 @@ type UnsignedNativeIntSource =
|
||||
type NativeIntSource =
|
||||
| Verbatim of int64
|
||||
| ManagedPointer of ManagedPointerSource
|
||||
| FunctionPointer of MethodInfo<FakeUnit, WoofWare.PawPrint.GenericParameter, TypeDefn>
|
||||
| FunctionPointer of MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle>
|
||||
| TypeHandlePtr of int64<typeHandle>
|
||||
|
||||
override this.ToString () : string =
|
||||
@@ -168,7 +167,6 @@ type CliTypeResolutionResult =
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module CliType =
|
||||
|
||||
let zeroOfPrimitive (primitiveType : PrimitiveType) : CliType =
|
||||
match primitiveType with
|
||||
| PrimitiveType.Boolean -> CliType.Bool 0uy
|
||||
@@ -194,92 +192,208 @@ module CliType =
|
||||
| PrimitiveType.Object -> CliType.ObjectRef None
|
||||
|
||||
let rec zeroOf
|
||||
(concreteTypes : AllConcreteTypes)
|
||||
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||
(corelib : BaseClassTypes<DumpedAssembly>)
|
||||
(assy : DumpedAssembly)
|
||||
(typeGenerics : TypeDefn ImmutableArray option)
|
||||
(methodGenerics : TypeDefn ImmutableArray option)
|
||||
(ty : TypeDefn)
|
||||
: CliTypeResolutionResult
|
||||
(handle : ConcreteTypeHandle)
|
||||
: CliType * AllConcreteTypes
|
||||
=
|
||||
match ty with
|
||||
| TypeDefn.PrimitiveType primitiveType -> CliTypeResolutionResult.Resolved (zeroOfPrimitive primitiveType)
|
||||
| TypeDefn.Array _ -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved
|
||||
| TypeDefn.Pinned typeDefn -> failwith "todo"
|
||||
| TypeDefn.Pointer _ ->
|
||||
CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null)
|
||||
|> CliTypeResolutionResult.Resolved
|
||||
| TypeDefn.Byref _ -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved
|
||||
| TypeDefn.OneDimensionalArrayLowerBoundZero _ -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved
|
||||
| TypeDefn.Modified (original, afterMod, modificationRequired) -> failwith "todo"
|
||||
| TypeDefn.FromReference (typeRef, signatureTypeKind) ->
|
||||
match signatureTypeKind with
|
||||
| SignatureTypeKind.Unknown -> failwith "todo"
|
||||
| SignatureTypeKind.ValueType ->
|
||||
match Assembly.resolveTypeRef assemblies assy typeRef typeGenerics with
|
||||
| TypeResolutionResult.Resolved (sourceAssy, ty) ->
|
||||
let fields =
|
||||
ty.Fields
|
||||
|> List.filter (fun field -> not (field.Attributes.HasFlag FieldAttributes.Static))
|
||||
|> List.map (fun fi ->
|
||||
match zeroOf assemblies corelib sourceAssy typeGenerics methodGenerics fi.Signature with
|
||||
| CliTypeResolutionResult.Resolved ty -> Ok (fi.Name, ty)
|
||||
| CliTypeResolutionResult.FirstLoad a -> Error a
|
||||
)
|
||||
|> Result.allOkOrError
|
||||
zeroOfWithVisited concreteTypes assemblies corelib handle Set.empty
|
||||
|
||||
match fields with
|
||||
| Error (_, []) -> failwith "logic error"
|
||||
| Error (_, f :: _) -> CliTypeResolutionResult.FirstLoad f
|
||||
| Ok fields -> CliType.ValueType fields |> CliTypeResolutionResult.Resolved
|
||||
| TypeResolutionResult.FirstLoadAssy assy -> CliTypeResolutionResult.FirstLoad assy
|
||||
| SignatureTypeKind.Class -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved
|
||||
| _ -> raise (ArgumentOutOfRangeException ())
|
||||
| TypeDefn.FromDefinition (typeDefinitionHandle, _, signatureTypeKind) ->
|
||||
let typeDef = assy.TypeDefs.[typeDefinitionHandle.Get]
|
||||
and zeroOfWithVisited
|
||||
(concreteTypes : AllConcreteTypes)
|
||||
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||
(corelib : BaseClassTypes<DumpedAssembly>)
|
||||
(handle : ConcreteTypeHandle)
|
||||
(visited : Set<ConcreteTypeHandle>)
|
||||
: CliType * AllConcreteTypes
|
||||
=
|
||||
|
||||
if typeDef = corelib.Int32 then
|
||||
zeroOfPrimitive PrimitiveType.Int32 |> CliTypeResolutionResult.Resolved
|
||||
elif typeDef = corelib.Int64 then
|
||||
zeroOfPrimitive PrimitiveType.Int64 |> CliTypeResolutionResult.Resolved
|
||||
elif typeDef = corelib.UInt32 then
|
||||
zeroOfPrimitive PrimitiveType.UInt32 |> CliTypeResolutionResult.Resolved
|
||||
elif typeDef = corelib.UInt64 then
|
||||
zeroOfPrimitive PrimitiveType.UInt64 |> CliTypeResolutionResult.Resolved
|
||||
// Handle constructed types first
|
||||
match handle with
|
||||
| ConcreteTypeHandle.Byref _ ->
|
||||
// Byref types are managed references - the zero value is a null reference
|
||||
CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null), concreteTypes
|
||||
|
||||
| ConcreteTypeHandle.Pointer _ ->
|
||||
// Pointer types are unmanaged pointers - the zero value is a null pointer
|
||||
CliType.RuntimePointer (CliRuntimePointer.Unmanaged 0L), concreteTypes
|
||||
|
||||
| ConcreteTypeHandle.Concrete _ ->
|
||||
// This is a concrete type - look it up in the mapping
|
||||
let concreteType =
|
||||
match AllConcreteTypes.lookup handle concreteTypes with
|
||||
| Some ct -> ct
|
||||
| None -> failwithf "ConcreteTypeHandle %A not found in AllConcreteTypes" handle
|
||||
|
||||
// Get the type definition from the assembly
|
||||
let assembly = assemblies.[concreteType.Assembly.FullName]
|
||||
let typeDef = assembly.TypeDefs.[concreteType.Definition.Get]
|
||||
|
||||
// Check if it's a primitive type by comparing with corelib types FIRST
|
||||
if concreteType.Assembly = corelib.Corelib.Name && concreteType.Generics.IsEmpty then
|
||||
// Check against known primitive types
|
||||
if TypeInfo.NominallyEqual typeDef corelib.Boolean then
|
||||
zeroOfPrimitive PrimitiveType.Boolean, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.Char then
|
||||
zeroOfPrimitive PrimitiveType.Char, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.SByte then
|
||||
zeroOfPrimitive PrimitiveType.SByte, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.Byte then
|
||||
zeroOfPrimitive PrimitiveType.Byte, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.Int16 then
|
||||
zeroOfPrimitive PrimitiveType.Int16, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.UInt16 then
|
||||
zeroOfPrimitive PrimitiveType.UInt16, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.Int32 then
|
||||
zeroOfPrimitive PrimitiveType.Int32, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.UInt32 then
|
||||
zeroOfPrimitive PrimitiveType.UInt32, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.Int64 then
|
||||
zeroOfPrimitive PrimitiveType.Int64, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.UInt64 then
|
||||
zeroOfPrimitive PrimitiveType.UInt64, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.Single then
|
||||
zeroOfPrimitive PrimitiveType.Single, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.Double then
|
||||
zeroOfPrimitive PrimitiveType.Double, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.String then
|
||||
zeroOfPrimitive PrimitiveType.String, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.Object then
|
||||
zeroOfPrimitive PrimitiveType.Object, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.IntPtr then
|
||||
zeroOfPrimitive PrimitiveType.IntPtr, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.UIntPtr then
|
||||
zeroOfPrimitive PrimitiveType.UIntPtr, concreteTypes
|
||||
else if
|
||||
// Check if it's an array type
|
||||
typeDef = corelib.Array
|
||||
then
|
||||
CliType.ObjectRef None, concreteTypes // Arrays are reference types
|
||||
else if
|
||||
// Not a known primitive, now check for cycles
|
||||
Set.contains handle visited
|
||||
then
|
||||
// We're in a cycle - return a default zero value for the type
|
||||
// For value types in cycles, we'll return a null reference as a safe fallback
|
||||
// This should only happen with self-referential types
|
||||
CliType.ObjectRef None, concreteTypes
|
||||
else
|
||||
let visited = Set.add handle visited
|
||||
// Not a known primitive, check if it's a value type or reference type
|
||||
determineZeroForCustomType concreteTypes assemblies corelib handle concreteType typeDef visited
|
||||
else if
|
||||
// Not from corelib or has generics
|
||||
concreteType.Assembly = corelib.Corelib.Name
|
||||
&& typeDef = corelib.Array
|
||||
&& concreteType.Generics.Length = 1
|
||||
then
|
||||
// This is an array type
|
||||
CliType.ObjectRef None, concreteTypes
|
||||
else if
|
||||
// Custom type - now check for cycles
|
||||
Set.contains handle visited
|
||||
then
|
||||
// We're in a cycle - return a default zero value for the type
|
||||
// For value types in cycles, we'll return a null reference as a safe fallback
|
||||
// This should only happen with self-referential types
|
||||
CliType.ObjectRef None, concreteTypes
|
||||
else
|
||||
// TODO: the rest
|
||||
match signatureTypeKind with
|
||||
| SignatureTypeKind.Unknown -> failwith "todo"
|
||||
| SignatureTypeKind.ValueType ->
|
||||
let fields =
|
||||
typeDef.Fields
|
||||
// oh lord, this is awfully ominous - I really don't want to store the statics here
|
||||
|> List.filter (fun field -> not (field.Attributes.HasFlag FieldAttributes.Static))
|
||||
|> List.map (fun fi ->
|
||||
match zeroOf assemblies corelib assy typeGenerics methodGenerics fi.Signature with
|
||||
| CliTypeResolutionResult.Resolved ty -> Ok (fi.Name, ty)
|
||||
| CliTypeResolutionResult.FirstLoad a -> Error a
|
||||
)
|
||||
|> Result.allOkOrError
|
||||
let visited = Set.add handle visited
|
||||
// Custom type - need to determine if it's a value type or reference type
|
||||
determineZeroForCustomType concreteTypes assemblies corelib handle concreteType typeDef visited
|
||||
|
||||
match fields with
|
||||
| Error (_, []) -> failwith "logic error"
|
||||
| Error (_, f :: _) -> CliTypeResolutionResult.FirstLoad f
|
||||
| Ok fields ->
|
||||
and private determineZeroForCustomType
|
||||
(concreteTypes : AllConcreteTypes)
|
||||
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||
(corelib : BaseClassTypes<DumpedAssembly>)
|
||||
(handle : ConcreteTypeHandle)
|
||||
(concreteType : ConcreteType<ConcreteTypeHandle>)
|
||||
(typeDef : WoofWare.PawPrint.TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>)
|
||||
(visited : Set<ConcreteTypeHandle>)
|
||||
: CliType * AllConcreteTypes
|
||||
=
|
||||
|
||||
CliType.ValueType fields |> CliTypeResolutionResult.Resolved
|
||||
| SignatureTypeKind.Class -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved
|
||||
| _ -> raise (ArgumentOutOfRangeException ())
|
||||
| TypeDefn.GenericInstantiation (generic, args) ->
|
||||
zeroOf assemblies corelib assy (Some args) methodGenerics generic
|
||||
| TypeDefn.FunctionPointer typeMethodSignature -> failwith "todo"
|
||||
| TypeDefn.GenericTypeParameter index ->
|
||||
// TODO: can generics depend on other generics? presumably, so we pass the array down again
|
||||
match typeGenerics with
|
||||
| None -> failwith "asked for a type parameter of generic type, but no generics in scope"
|
||||
| Some generics -> zeroOf assemblies corelib assy (Some generics) methodGenerics generics.[index]
|
||||
| TypeDefn.GenericMethodParameter index ->
|
||||
match methodGenerics with
|
||||
| None -> failwith "asked for a method parameter of generic type, but no generics in scope"
|
||||
| Some generics -> zeroOf assemblies corelib assy typeGenerics (Some generics) generics.[index]
|
||||
| TypeDefn.Void -> failwith "should never construct an element of type Void"
|
||||
// Determine if this is a value type by checking inheritance
|
||||
let isValueType =
|
||||
match DumpedAssembly.resolveBaseType corelib assemblies typeDef.Assembly typeDef.BaseType with
|
||||
| ResolvedBaseType.ValueType
|
||||
| ResolvedBaseType.Enum -> true
|
||||
| ResolvedBaseType.Delegate -> false // Delegates are reference types
|
||||
| ResolvedBaseType.Object -> false
|
||||
|
||||
if isValueType then
|
||||
// It's a value type - need to create zero values for all non-static fields
|
||||
let mutable currentConcreteTypes = concreteTypes
|
||||
|
||||
let fieldZeros =
|
||||
typeDef.Fields
|
||||
|> List.filter (fun field -> not (field.Attributes.HasFlag FieldAttributes.Static))
|
||||
|> List.map (fun field ->
|
||||
// Need to concretize the field type with the concrete type's generics
|
||||
let fieldTypeDefn = field.Signature
|
||||
|
||||
let fieldHandle, updatedConcreteTypes =
|
||||
concretizeFieldType currentConcreteTypes assemblies corelib concreteType fieldTypeDefn
|
||||
|
||||
currentConcreteTypes <- updatedConcreteTypes
|
||||
|
||||
let fieldZero, updatedConcreteTypes2 =
|
||||
zeroOfWithVisited currentConcreteTypes assemblies corelib fieldHandle visited
|
||||
|
||||
currentConcreteTypes <- updatedConcreteTypes2
|
||||
(field.Name, fieldZero)
|
||||
)
|
||||
|
||||
CliType.ValueType fieldZeros, currentConcreteTypes
|
||||
else
|
||||
// It's a reference type
|
||||
CliType.ObjectRef None, concreteTypes
|
||||
|
||||
and private concretizeFieldType
|
||||
(concreteTypes : AllConcreteTypes)
|
||||
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||
(corelib : BaseClassTypes<DumpedAssembly>)
|
||||
(declaringType : ConcreteType<ConcreteTypeHandle>)
|
||||
(fieldType : TypeDefn)
|
||||
: ConcreteTypeHandle * AllConcreteTypes
|
||||
=
|
||||
|
||||
// Create a concretization context
|
||||
let ctx =
|
||||
{
|
||||
TypeConcretization.ConcretizationContext.InProgress = ImmutableDictionary.Empty
|
||||
TypeConcretization.ConcretizationContext.ConcreteTypes = concreteTypes
|
||||
TypeConcretization.ConcretizationContext.LoadedAssemblies = assemblies
|
||||
TypeConcretization.ConcretizationContext.BaseTypes = corelib
|
||||
}
|
||||
|
||||
// The field type might reference generic parameters of the declaring type
|
||||
let typeGenerics = declaringType.Generics |> ImmutableArray.CreateRange
|
||||
let methodGenerics = ImmutableArray.Empty // Fields don't have method generics
|
||||
|
||||
let loadAssembly
|
||||
(assyName : AssemblyName)
|
||||
(ref : AssemblyReferenceHandle)
|
||||
: (ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
|
||||
=
|
||||
match assemblies.TryGetValue assyName.FullName with
|
||||
| true, currentAssy ->
|
||||
let targetAssyRef = currentAssy.AssemblyReferences.[ref]
|
||||
|
||||
match assemblies.TryGetValue targetAssyRef.Name.FullName with
|
||||
| true, targetAssy -> assemblies, targetAssy
|
||||
| false, _ ->
|
||||
failwithf "Assembly %s not loaded when trying to resolve reference" targetAssyRef.Name.FullName
|
||||
| false, _ -> failwithf "Current assembly %s not loaded when trying to resolve reference" assyName.FullName
|
||||
|
||||
let handle, newCtx =
|
||||
TypeConcretization.concretizeType
|
||||
ctx
|
||||
loadAssembly
|
||||
declaringType.Assembly
|
||||
typeGenerics
|
||||
methodGenerics
|
||||
fieldType
|
||||
|
||||
handle, newCtx.ConcreteTypes
|
||||
|
File diff suppressed because it is too large
Load Diff
@@ -6,7 +6,7 @@ type MethodReturnState =
|
||||
{
|
||||
/// Index in the MethodStates array of a ThreadState
|
||||
JumpTo : int
|
||||
WasInitialisingType : RuntimeConcreteType option
|
||||
WasInitialisingType : ConcreteTypeHandle option
|
||||
/// The Newobj instruction means we need to push a reference immediately after Ret.
|
||||
WasConstructingObj : ManagedHeapAddress option
|
||||
}
|
||||
@@ -19,16 +19,16 @@ and MethodState =
|
||||
_IlOpIndex : int
|
||||
EvaluationStack : EvalStack
|
||||
Arguments : CliType ImmutableArray
|
||||
ExecutingMethod : WoofWare.PawPrint.MethodInfo<TypeDefn, TypeDefn, TypeDefn>
|
||||
ExecutingMethod : WoofWare.PawPrint.MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle>
|
||||
/// We don't implement the local memory pool right now
|
||||
LocalMemoryPool : unit
|
||||
/// On return, we restore this state. This should be Some almost always; an exception is the entry point.
|
||||
ReturnState : MethodReturnState option
|
||||
Generics : ImmutableArray<TypeDefn> option
|
||||
Generics : ImmutableArray<ConcreteTypeHandle>
|
||||
/// Track which exception regions are currently active (innermost first)
|
||||
ActiveExceptionRegions : ExceptionRegion list
|
||||
/// When executing a finally/fault/filter, we need to know where to return
|
||||
ExceptionContinuation : ExceptionContinuation<TypeDefn, TypeDefn, TypeDefn> option
|
||||
ExceptionContinuation : ExceptionContinuation<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle> option
|
||||
}
|
||||
|
||||
member this.IlOpIndex = this._IlOpIndex
|
||||
@@ -136,11 +136,12 @@ and MethodState =
|
||||
/// If `method` is an instance method, `args` must be of length 1+numParams.
|
||||
/// If `method` is static, `args` must be of length numParams.
|
||||
static member Empty
|
||||
(concreteTypes : AllConcreteTypes)
|
||||
(corelib : BaseClassTypes<DumpedAssembly>)
|
||||
(loadedAssemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||
(containingAssembly : DumpedAssembly)
|
||||
(method : WoofWare.PawPrint.MethodInfo<TypeDefn, TypeDefn, TypeDefn>)
|
||||
(methodGenerics : ImmutableArray<TypeDefn> option)
|
||||
(method : WoofWare.PawPrint.MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle>)
|
||||
(methodGenerics : ImmutableArray<ConcreteTypeHandle>)
|
||||
(args : ImmutableArray<CliType>)
|
||||
(returnState : MethodReturnState option)
|
||||
: Result<MethodState, WoofWare.PawPrint.AssemblyReference list>
|
||||
@@ -164,28 +165,18 @@ and MethodState =
|
||||
// I think valid code should remain valid if we unconditionally localsInit - it should be undefined
|
||||
// to use an uninitialised value? Not checked this; TODO.
|
||||
|
||||
let requiredAssemblies = ResizeArray<WoofWare.PawPrint.AssemblyReference> ()
|
||||
|
||||
let typeGenerics =
|
||||
match method.DeclaringType.Generics with
|
||||
| [] -> None
|
||||
| x -> ImmutableArray.CreateRange x |> Some
|
||||
|
||||
let localVars =
|
||||
let result = ImmutableArray.CreateBuilder ()
|
||||
|
||||
for var in localVariableSig do
|
||||
match CliType.zeroOf loadedAssemblies corelib containingAssembly typeGenerics methodGenerics var with
|
||||
| CliTypeResolutionResult.Resolved t -> result.Add t
|
||||
| CliTypeResolutionResult.FirstLoad (assy : WoofWare.PawPrint.AssemblyReference) ->
|
||||
requiredAssemblies.Add assy
|
||||
// Note: This assumes all types have already been concretized
|
||||
// If this fails with "ConcreteTypeHandle not found", it means
|
||||
// we need to ensure types are concretized before creating the MethodState
|
||||
let zero, _ = CliType.zeroOf concreteTypes loadedAssemblies corelib var
|
||||
result.Add zero
|
||||
|
||||
result.ToImmutable ()
|
||||
|
||||
if requiredAssemblies.Count > 0 then
|
||||
Error (requiredAssemblies |> Seq.toList)
|
||||
else
|
||||
|
||||
let activeRegions = ExceptionHandling.getActiveRegionsAtOffset 0 method
|
||||
|
||||
{
|
||||
|
@@ -17,11 +17,7 @@ module Program =
|
||||
let argsAllocations, state =
|
||||
(state, args)
|
||||
||> Seq.mapFold (fun state arg ->
|
||||
IlMachineState.allocateManagedObject
|
||||
(corelib.String
|
||||
|> TypeInfo.mapGeneric (fun _ _ -> failwith<unit> "there are no generics here"))
|
||||
(failwith "TODO: assert fields and populate")
|
||||
state
|
||||
IlMachineState.allocateManagedObject corelib.String (failwith "TODO: assert fields and populate") state
|
||||
// TODO: set the char values in memory
|
||||
)
|
||||
|
||||
@@ -83,71 +79,177 @@ module Program =
|
||||
| None -> failwith "No entry point in input DLL"
|
||||
| Some d -> d
|
||||
|
||||
let mainMethod = dumped.Methods.[entryPoint]
|
||||
let mainMethodFromMetadata = dumped.Methods.[entryPoint]
|
||||
|
||||
if mainMethod.Signature.GenericParameterCount > 0 then
|
||||
if mainMethodFromMetadata.Signature.GenericParameterCount > 0 then
|
||||
failwith "Refusing to execute generic main method"
|
||||
|
||||
let mainMethod =
|
||||
mainMethod
|
||||
|> MethodInfo.mapTypeGenerics (fun _ -> failwith "Refusing to execute generic main method")
|
||||
|> MethodInfo.mapMethodGenerics (fun _ -> failwith "Refusing to execute generic main method")
|
||||
let state = IlMachineState.initial loggerFactory dotnetRuntimeDirs dumped
|
||||
|
||||
let rec computeState (baseClassTypes : BaseClassTypes<DumpedAssembly> option) (state : IlMachineState) =
|
||||
// The thread's state is slightly fake: we will need to put arguments onto the stack before actually
|
||||
// executing the main method.
|
||||
// We construct the thread here before we are entirely ready, because we need a thread from which to
|
||||
// initialise the class containing the main method.
|
||||
// Once we've obtained e.g. the String and Array classes, we can populate the args array.
|
||||
match
|
||||
MethodState.Empty
|
||||
(Option.toObj baseClassTypes)
|
||||
state._LoadedAssemblies
|
||||
dumped
|
||||
// pretend there are no instructions, so we avoid preparing anything
|
||||
{ mainMethod with
|
||||
Instructions = Some (MethodInstructions.onlyRet ())
|
||||
}
|
||||
None
|
||||
(ImmutableArray.CreateRange [ CliType.ObjectRef None ])
|
||||
None
|
||||
with
|
||||
| Ok meth -> IlMachineState.addThread meth dumped.Name state, baseClassTypes
|
||||
| Error requiresRefs ->
|
||||
let state =
|
||||
(state, requiresRefs)
|
||||
||> List.fold (fun state ref ->
|
||||
let handle, referencingAssy = ref.Handle
|
||||
let referencingAssy = state.LoadedAssembly referencingAssy |> Option.get
|
||||
// Find the core library by traversing the type hierarchy of the main method's declaring type
|
||||
// until we reach System.Object
|
||||
let rec handleBaseTypeInfo
|
||||
(state : IlMachineState)
|
||||
(baseTypeInfo : BaseTypeInfo)
|
||||
(currentAssembly : DumpedAssembly)
|
||||
(continueWithGeneric :
|
||||
IlMachineState
|
||||
-> TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
|
||||
-> DumpedAssembly
|
||||
-> IlMachineState * BaseClassTypes<DumpedAssembly> option)
|
||||
(continueWithResolved :
|
||||
IlMachineState
|
||||
-> TypeInfo<TypeDefn, TypeDefn>
|
||||
-> DumpedAssembly
|
||||
-> IlMachineState * BaseClassTypes<DumpedAssembly> option)
|
||||
: IlMachineState * BaseClassTypes<DumpedAssembly> option
|
||||
=
|
||||
match baseTypeInfo with
|
||||
| BaseTypeInfo.TypeRef typeRefHandle ->
|
||||
// Look up the TypeRef from the handle
|
||||
let typeRef = currentAssembly.TypeRefs.[typeRefHandle]
|
||||
|
||||
let rec go state =
|
||||
// Resolve the type reference to find which assembly it's in
|
||||
match
|
||||
Assembly.resolveTypeRef state._LoadedAssemblies currentAssembly typeRef ImmutableArray.Empty
|
||||
with
|
||||
| TypeResolutionResult.FirstLoadAssy assyRef ->
|
||||
// Need to load this assembly first
|
||||
let handle, definedIn = assyRef.Handle
|
||||
|
||||
let state, _, _ =
|
||||
IlMachineState.loadAssembly loggerFactory referencingAssy handle state
|
||||
IlMachineState.loadAssembly
|
||||
loggerFactory
|
||||
state._LoadedAssemblies.[definedIn.FullName]
|
||||
handle
|
||||
state
|
||||
|
||||
go state
|
||||
| TypeResolutionResult.Resolved (resolvedAssembly, resolvedType) ->
|
||||
continueWithResolved state resolvedType resolvedAssembly
|
||||
|
||||
go state
|
||||
| BaseTypeInfo.TypeDef typeDefHandle ->
|
||||
// Base type is in the same assembly
|
||||
let baseType = currentAssembly.TypeDefs.[typeDefHandle]
|
||||
continueWithGeneric state baseType currentAssembly
|
||||
| BaseTypeInfo.TypeSpec _ -> failwith "Type specs not yet supported in base type traversal"
|
||||
| BaseTypeInfo.ForeignAssemblyType (assemblyName, typeDefHandle) ->
|
||||
// Base type is in a foreign assembly
|
||||
match state._LoadedAssemblies.TryGetValue assemblyName.FullName with
|
||||
| true, foreignAssembly ->
|
||||
let baseType = foreignAssembly.TypeDefs.[typeDefHandle]
|
||||
continueWithGeneric state baseType foreignAssembly
|
||||
| false, _ -> failwith $"Foreign assembly {assemblyName.FullName} not loaded"
|
||||
|
||||
let rec findCoreLibraryAssemblyFromGeneric
|
||||
(state : IlMachineState)
|
||||
(currentType : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>)
|
||||
(currentAssembly : DumpedAssembly)
|
||||
=
|
||||
match currentType.BaseType with
|
||||
| None ->
|
||||
// We've reached the root (System.Object), so this assembly contains the core library
|
||||
let baseTypes = Corelib.getBaseTypes currentAssembly
|
||||
state, Some baseTypes
|
||||
| Some baseTypeInfo ->
|
||||
handleBaseTypeInfo
|
||||
state
|
||||
baseTypeInfo
|
||||
currentAssembly
|
||||
findCoreLibraryAssemblyFromGeneric
|
||||
findCoreLibraryAssemblyFromResolved
|
||||
|
||||
and findCoreLibraryAssemblyFromResolved
|
||||
(state : IlMachineState)
|
||||
(currentType : TypeInfo<TypeDefn, TypeDefn>)
|
||||
(currentAssembly : DumpedAssembly)
|
||||
=
|
||||
match currentType.BaseType with
|
||||
| None ->
|
||||
// We've reached the root (System.Object), so this assembly contains the core library
|
||||
let baseTypes = Corelib.getBaseTypes currentAssembly
|
||||
state, Some baseTypes
|
||||
| Some baseTypeInfo ->
|
||||
handleBaseTypeInfo
|
||||
state
|
||||
baseTypeInfo
|
||||
currentAssembly
|
||||
findCoreLibraryAssemblyFromGeneric
|
||||
findCoreLibraryAssemblyFromResolved
|
||||
|
||||
let rec computeState (baseClassTypes : BaseClassTypes<DumpedAssembly> option) (state : IlMachineState) =
|
||||
match baseClassTypes with
|
||||
| Some baseTypes ->
|
||||
// We already have base class types, can directly create the concretized method
|
||||
// Use the original method from metadata, but convert FakeUnit to TypeDefn
|
||||
let rawMainMethod =
|
||||
mainMethodFromMetadata
|
||||
|> MethodInfo.mapTypeGenerics (fun i _ -> TypeDefn.GenericTypeParameter i)
|
||||
|
||||
let state, concretizedMainMethod, _ =
|
||||
IlMachineState.concretizeMethodWithTypeGenerics
|
||||
loggerFactory
|
||||
baseTypes
|
||||
ImmutableArray.Empty // No type generics for main method's declaring type
|
||||
{ rawMainMethod with
|
||||
Instructions = Some (MethodInstructions.onlyRet ())
|
||||
}
|
||||
None
|
||||
dumped.Name
|
||||
ImmutableArray.Empty
|
||||
state
|
||||
)
|
||||
|
||||
let corelib =
|
||||
let coreLib =
|
||||
state._LoadedAssemblies.Keys
|
||||
|> Seq.tryFind (fun x -> x.StartsWith ("System.Private.CoreLib, ", StringComparison.Ordinal))
|
||||
// Create the method state with the concretized method
|
||||
match
|
||||
MethodState.Empty
|
||||
state.ConcreteTypes
|
||||
baseTypes
|
||||
state._LoadedAssemblies
|
||||
dumped
|
||||
concretizedMainMethod
|
||||
ImmutableArray.Empty
|
||||
(ImmutableArray.CreateRange [ CliType.ObjectRef None ])
|
||||
None
|
||||
with
|
||||
| Ok concretizedMeth -> IlMachineState.addThread concretizedMeth dumped.Name state, Some baseTypes
|
||||
| Error _ -> failwith "Unexpected failure creating method state with concretized method"
|
||||
| None ->
|
||||
// We need to discover the core library by traversing the type hierarchy
|
||||
let mainMethodType =
|
||||
dumped.TypeDefs.[mainMethodFromMetadata.DeclaringType.Definition.Get]
|
||||
|
||||
coreLib
|
||||
|> Option.map (fun coreLib -> state._LoadedAssemblies.[coreLib] |> Corelib.getBaseTypes)
|
||||
let state, baseTypes =
|
||||
findCoreLibraryAssemblyFromGeneric state mainMethodType dumped
|
||||
|
||||
computeState corelib state
|
||||
computeState baseTypes state
|
||||
|
||||
let (state, mainThread), baseClassTypes =
|
||||
IlMachineState.initial loggerFactory dotnetRuntimeDirs dumped
|
||||
|> computeState None
|
||||
let (state, mainThread), baseClassTypes = state |> computeState None
|
||||
|
||||
// Now that we have base class types, concretize the main method for use in the rest of the function
|
||||
let state, concretizedMainMethod, mainTypeHandle =
|
||||
match baseClassTypes with
|
||||
| Some baseTypes ->
|
||||
let rawMainMethod =
|
||||
mainMethodFromMetadata
|
||||
|> MethodInfo.mapTypeGenerics (fun i _ -> TypeDefn.GenericTypeParameter i)
|
||||
|
||||
IlMachineState.concretizeMethodWithTypeGenerics
|
||||
loggerFactory
|
||||
baseTypes
|
||||
ImmutableArray.Empty // No type generics for main method's declaring type
|
||||
rawMainMethod
|
||||
None
|
||||
dumped.Name
|
||||
ImmutableArray.Empty
|
||||
state
|
||||
| None -> failwith "Expected base class types to be available at this point"
|
||||
|
||||
let rec loadInitialState (state : IlMachineState) =
|
||||
match
|
||||
state
|
||||
|> IlMachineState.loadClass
|
||||
loggerFactory
|
||||
(Option.toObj baseClassTypes)
|
||||
mainMethod.DeclaringType
|
||||
mainThread
|
||||
|> IlMachineState.loadClass loggerFactory (Option.toObj baseClassTypes) mainTypeHandle mainThread
|
||||
with
|
||||
| StateLoadResult.NothingToDo ilMachineState -> ilMachineState
|
||||
| StateLoadResult.FirstLoadThis ilMachineState -> loadInitialState ilMachineState
|
||||
@@ -167,12 +269,12 @@ module Program =
|
||||
| Some c -> c
|
||||
|
||||
let arrayAllocation, state =
|
||||
match mainMethod.Signature.ParameterTypes |> Seq.toList with
|
||||
match mainMethodFromMetadata.Signature.ParameterTypes |> Seq.toList with
|
||||
| [ TypeDefn.OneDimensionalArrayLowerBoundZero (TypeDefn.PrimitiveType PrimitiveType.String) ] ->
|
||||
allocateArgs argv baseClassTypes state
|
||||
| _ -> failwith "Main method must take an array of strings; other signatures not yet implemented"
|
||||
|
||||
match mainMethod.Signature.ReturnType with
|
||||
match mainMethodFromMetadata.Signature.ReturnType with
|
||||
| TypeDefn.PrimitiveType PrimitiveType.Int32 -> ()
|
||||
| _ -> failwith "Main method must return int32; other types not currently supported"
|
||||
|
||||
@@ -185,15 +287,16 @@ module Program =
|
||||
logger.LogInformation "Main method class now initialised"
|
||||
|
||||
// Now that BCL initialisation has taken place and the user-code classes are constructed,
|
||||
// overwrite the main thread completely.
|
||||
// overwrite the main thread completely using the already-concretized method.
|
||||
let methodState =
|
||||
match
|
||||
MethodState.Empty
|
||||
state.ConcreteTypes
|
||||
baseClassTypes
|
||||
state._LoadedAssemblies
|
||||
dumped
|
||||
mainMethod
|
||||
None
|
||||
concretizedMainMethod
|
||||
ImmutableArray.Empty
|
||||
(ImmutableArray.Create (CliType.OfManagedObject arrayAllocation))
|
||||
None
|
||||
with
|
||||
@@ -210,11 +313,7 @@ module Program =
|
||||
{ state with
|
||||
ThreadState = state.ThreadState |> Map.add mainThread threadState
|
||||
}
|
||||
|> IlMachineState.ensureTypeInitialised
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
mainThread
|
||||
methodState.ExecutingMethod.DeclaringType
|
||||
|> IlMachineState.ensureTypeInitialised loggerFactory baseClassTypes mainThread mainTypeHandle
|
||||
|
||||
match init with
|
||||
| WhatWeDid.SuspendedForClassInit -> failwith "TODO: suspended for class init"
|
||||
|
@@ -4,3 +4,5 @@ namespace WoofWare.PawPrint
|
||||
module internal Tuple =
|
||||
let withLeft<'a, 'b> (x : 'a) (y : 'b) : 'a * 'b = x, y
|
||||
let withRight<'a, 'b> (y : 'b) (x : 'a) = x, y
|
||||
let lmap<'a, 'b, 'c> (f : 'a -> 'c) (x : 'a, y : 'b) : 'c * 'b = f x, y
|
||||
let rmap<'a, 'b, 'c> (f : 'b -> 'c) (x : 'a, y : 'b) : 'a * 'c = x, f y
|
||||
|
@@ -9,21 +9,21 @@ type TypeInitState =
|
||||
|
||||
/// Tracks the initialization state of types across assemblies. The string in the key is the FullName of the AssemblyName where the type comes from.
|
||||
// TODO: need a better solution than string here! AssemblyName didn't work, we had nonequal assembly names.
|
||||
type TypeInitTable = ImmutableDictionary<RuntimeConcreteType, TypeInitState>
|
||||
type TypeInitTable = ImmutableDictionary<ConcreteTypeHandle, TypeInitState>
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module TypeInitTable =
|
||||
let tryGet (ty : RuntimeConcreteType) (t : TypeInitTable) =
|
||||
let tryGet (ty : ConcreteTypeHandle) (t : TypeInitTable) =
|
||||
match t.TryGetValue ty with
|
||||
| true, v -> Some v
|
||||
| false, _ -> None
|
||||
|
||||
let beginInitialising (thread : ThreadId) (ty : RuntimeConcreteType) (t : TypeInitTable) : TypeInitTable =
|
||||
let beginInitialising (thread : ThreadId) (ty : ConcreteTypeHandle) (t : TypeInitTable) : TypeInitTable =
|
||||
match t.TryGetValue ty with
|
||||
| false, _ -> t.Add (ty, TypeInitState.InProgress thread)
|
||||
| true, v -> failwith "Logic error: tried initialising a type which has already started initialising"
|
||||
|
||||
let markInitialised (thread : ThreadId) (ty : RuntimeConcreteType) (t : TypeInitTable) : TypeInitTable =
|
||||
let markInitialised (thread : ThreadId) (ty : ConcreteTypeHandle) (t : TypeInitTable) : TypeInitTable =
|
||||
match t.TryGetValue ty with
|
||||
| false, _ -> failwith "Logic error: completing initialisation of a type which never started initialising"
|
||||
| true, TypeInitState.Initialized ->
|
||||
|
@@ -20,7 +20,7 @@ module internal UnaryMetadataIlOp =
|
||||
|
||||
match op with
|
||||
| Call ->
|
||||
let state, methodToCall, methodGenerics =
|
||||
let state, methodToCall, methodGenerics, typeArgsFromMetadata =
|
||||
match metadataToken with
|
||||
| MetadataToken.MethodSpecification h ->
|
||||
let spec = activeAssy.MethodSpecs.[h]
|
||||
@@ -29,11 +29,11 @@ module internal UnaryMetadataIlOp =
|
||||
| MetadataToken.MethodDef token ->
|
||||
let method =
|
||||
activeAssy.Methods.[token]
|
||||
|> MethodInfo.mapTypeGenerics (fun i _ -> spec.Signature.[i])
|
||||
|> MethodInfo.mapTypeGenerics (fun i _ -> TypeDefn.GenericTypeParameter i)
|
||||
|
||||
state, method, Some spec.Signature
|
||||
state, method, Some spec.Signature, None
|
||||
| MetadataToken.MemberReference ref ->
|
||||
let state, _, method =
|
||||
let state, _, method, extractedTypeArgs =
|
||||
IlMachineState.resolveMember
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
@@ -44,10 +44,10 @@ module internal UnaryMetadataIlOp =
|
||||
|
||||
match method with
|
||||
| Choice2Of2 _field -> failwith "tried to Call a field"
|
||||
| Choice1Of2 method -> state, method, Some spec.Signature
|
||||
| Choice1Of2 method -> state, method, Some spec.Signature, Some extractedTypeArgs
|
||||
| k -> failwith $"Unrecognised kind: %O{k}"
|
||||
| MetadataToken.MemberReference h ->
|
||||
let state, _, method =
|
||||
let state, _, method, extractedTypeArgs =
|
||||
IlMachineState.resolveMember
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
@@ -58,34 +58,52 @@ module internal UnaryMetadataIlOp =
|
||||
|
||||
match method with
|
||||
| Choice2Of2 _field -> failwith "tried to Call a field"
|
||||
| Choice1Of2 method -> state, method, None
|
||||
| Choice1Of2 method -> state, method, None, Some extractedTypeArgs
|
||||
|
||||
| MetadataToken.MethodDef defn ->
|
||||
match activeAssy.Methods.TryGetValue defn with
|
||||
| true, method ->
|
||||
let method = method |> MethodInfo.mapTypeGenerics (fun _ -> failwith "not generic")
|
||||
state, method, None
|
||||
state, method, None, None
|
||||
| false, _ -> failwith $"could not find method in {activeAssy.Name}"
|
||||
| k -> failwith $"Unrecognised kind: %O{k}"
|
||||
|
||||
match IlMachineState.loadClass loggerFactory baseClassTypes methodToCall.DeclaringType thread state with
|
||||
| NothingToDo state ->
|
||||
state.WithThreadSwitchedToAssembly methodToCall.DeclaringType.Assembly thread
|
||||
|> fst
|
||||
|> IlMachineState.callMethodInActiveAssembly
|
||||
let state, concretizedMethod, declaringTypeHandle =
|
||||
IlMachineState.concretizeMethodForExecution
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
thread
|
||||
true
|
||||
methodGenerics
|
||||
methodToCall
|
||||
methodGenerics
|
||||
typeArgsFromMetadata
|
||||
state
|
||||
|
||||
match IlMachineState.loadClass loggerFactory baseClassTypes declaringTypeHandle thread state with
|
||||
| NothingToDo state ->
|
||||
let state, _ =
|
||||
state.WithThreadSwitchedToAssembly methodToCall.DeclaringType.Assembly thread
|
||||
|
||||
let threadState = state.ThreadState.[thread]
|
||||
|
||||
IlMachineState.callMethod
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
None
|
||||
None
|
||||
false
|
||||
true
|
||||
concretizedMethod.Generics
|
||||
concretizedMethod
|
||||
thread
|
||||
threadState
|
||||
state,
|
||||
WhatWeDid.Executed
|
||||
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
|
||||
|
||||
| Callvirt ->
|
||||
|
||||
// TODO: this is presumably super incomplete
|
||||
let state, method, generics =
|
||||
let state, methodToCall, methodGenerics, typeArgsFromMetadata =
|
||||
match metadataToken with
|
||||
| MetadataToken.MethodSpecification h ->
|
||||
let spec = activeAssy.MethodSpecs.[h]
|
||||
@@ -96,9 +114,9 @@ module internal UnaryMetadataIlOp =
|
||||
activeAssy.Methods.[token]
|
||||
|> MethodInfo.mapTypeGenerics (fun i _ -> spec.Signature.[i])
|
||||
|
||||
state, method, Some spec.Signature
|
||||
state, method, Some spec.Signature, None
|
||||
| MetadataToken.MemberReference ref ->
|
||||
let state, _, method =
|
||||
let state, _, method, extractedTypeArgs =
|
||||
IlMachineState.resolveMember
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
@@ -109,10 +127,10 @@ module internal UnaryMetadataIlOp =
|
||||
|
||||
match method with
|
||||
| Choice2Of2 _field -> failwith "tried to Callvirt a field"
|
||||
| Choice1Of2 method -> state, method, Some spec.Signature
|
||||
| Choice1Of2 method -> state, method, Some spec.Signature, Some extractedTypeArgs
|
||||
| k -> failwith $"Unrecognised kind: %O{k}"
|
||||
| MetadataToken.MemberReference h ->
|
||||
let state, _, method =
|
||||
let state, _, method, extractedTypeArgs =
|
||||
IlMachineState.resolveMember
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
@@ -123,35 +141,58 @@ module internal UnaryMetadataIlOp =
|
||||
|
||||
match method with
|
||||
| Choice2Of2 _field -> failwith "tried to Callvirt a field"
|
||||
| Choice1Of2 method -> state, method, None
|
||||
| Choice1Of2 method -> state, method, None, Some extractedTypeArgs
|
||||
|
||||
| MetadataToken.MethodDef defn ->
|
||||
match activeAssy.Methods.TryGetValue defn with
|
||||
| true, method ->
|
||||
let method = method |> MethodInfo.mapTypeGenerics (fun _ -> failwith "not generic")
|
||||
state, method, None
|
||||
state, method, None, None
|
||||
| false, _ -> failwith $"could not find method in {activeAssy.Name}"
|
||||
| k -> failwith $"Unrecognised kind: %O{k}"
|
||||
|
||||
match IlMachineState.loadClass loggerFactory baseClassTypes method.DeclaringType thread state with
|
||||
// TODO: this is pretty inefficient, we're concretising here and then immediately after in callMethodInActiveAssembly
|
||||
let state, concretizedMethod, declaringTypeHandle =
|
||||
IlMachineState.concretizeMethodForExecution
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
thread
|
||||
methodToCall
|
||||
methodGenerics
|
||||
typeArgsFromMetadata
|
||||
state
|
||||
|
||||
match IlMachineState.loadClass loggerFactory baseClassTypes declaringTypeHandle thread state with
|
||||
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
|
||||
| NothingToDo state ->
|
||||
|
||||
state.WithThreadSwitchedToAssembly method.DeclaringType.Assembly thread
|
||||
state.WithThreadSwitchedToAssembly methodToCall.DeclaringType.Assembly thread
|
||||
|> fst
|
||||
|> IlMachineState.callMethodInActiveAssembly loggerFactory baseClassTypes thread true generics method None
|
||||
|> IlMachineState.callMethodInActiveAssembly
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
thread
|
||||
true
|
||||
methodGenerics
|
||||
methodToCall
|
||||
None
|
||||
typeArgsFromMetadata
|
||||
|
||||
| Castclass -> failwith "TODO: Castclass unimplemented"
|
||||
| Newobj ->
|
||||
let logger = loggerFactory.CreateLogger "Newobj"
|
||||
|
||||
let state, assy, ctor =
|
||||
let state, assy, ctor, typeArgsFromMetadata =
|
||||
match metadataToken with
|
||||
| MethodDef md ->
|
||||
let method = activeAssy.Methods.[md]
|
||||
state, activeAssy.Name, MethodInfo.mapTypeGenerics (fun _ -> failwith "non-generic method") method
|
||||
|
||||
state,
|
||||
activeAssy.Name,
|
||||
MethodInfo.mapTypeGenerics (fun _ -> failwith "non-generic method") method,
|
||||
None
|
||||
| MemberReference mr ->
|
||||
let state, name, method =
|
||||
let state, name, method, extractedTypeArgs =
|
||||
IlMachineState.resolveMember
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
@@ -161,12 +202,24 @@ module internal UnaryMetadataIlOp =
|
||||
state
|
||||
|
||||
match method with
|
||||
| Choice1Of2 mr -> state, name, mr
|
||||
| Choice1Of2 mr -> state, name, mr, Some extractedTypeArgs
|
||||
| Choice2Of2 _field -> failwith "unexpectedly NewObj found a constructor which is a field"
|
||||
| x -> failwith $"Unexpected metadata token for constructor: %O{x}"
|
||||
|
||||
let currentMethod = state.ThreadState.[thread].MethodState.ExecutingMethod
|
||||
|
||||
let state, concretizedCtor, declaringTypeHandle =
|
||||
IlMachineState.concretizeMethodForExecution
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
thread
|
||||
ctor
|
||||
None
|
||||
typeArgsFromMetadata
|
||||
state
|
||||
|
||||
let state, init =
|
||||
IlMachineState.ensureTypeInitialised loggerFactory baseClassTypes thread ctor.DeclaringType state
|
||||
IlMachineState.ensureTypeInitialised loggerFactory baseClassTypes thread declaringTypeHandle state
|
||||
|
||||
match init with
|
||||
| WhatWeDid.BlockedOnClassInit state -> failwith "TODO: another thread is running the initialiser"
|
||||
@@ -184,9 +237,7 @@ module internal UnaryMetadataIlOp =
|
||||
)
|
||||
|
||||
let typeGenerics =
|
||||
match ctor.DeclaringType.Generics with
|
||||
| [] -> None
|
||||
| l -> Some (ImmutableArray.CreateRange l)
|
||||
concretizedCtor.DeclaringType.Generics |> ImmutableArray.CreateRange
|
||||
|
||||
let state, fieldZeros =
|
||||
((state, []), ctorType.Fields)
|
||||
@@ -199,7 +250,7 @@ module internal UnaryMetadataIlOp =
|
||||
ctorAssembly
|
||||
field.Signature
|
||||
typeGenerics
|
||||
None
|
||||
ImmutableArray.Empty
|
||||
state
|
||||
|
||||
state, (field.Name, zero) :: zeros
|
||||
@@ -232,6 +283,7 @@ module internal UnaryMetadataIlOp =
|
||||
None
|
||||
ctor
|
||||
(Some allocatedAddr)
|
||||
typeArgsFromMetadata
|
||||
|
||||
match whatWeDid with
|
||||
| SuspendedForClassInit -> failwith "unexpectedly suspended while initialising constructor"
|
||||
@@ -255,9 +307,8 @@ module internal UnaryMetadataIlOp =
|
||||
| popped -> failwith $"unexpectedly popped value %O{popped} to serve as array len"
|
||||
|
||||
let typeGenerics =
|
||||
match newMethodState.ExecutingMethod.DeclaringType.Generics with
|
||||
| [] -> None
|
||||
| l -> Some (ImmutableArray.CreateRange l)
|
||||
newMethodState.ExecutingMethod.DeclaringType.Generics
|
||||
|> ImmutableArray.CreateRange
|
||||
|
||||
let state, elementType, assy =
|
||||
match metadataToken with
|
||||
@@ -274,14 +325,30 @@ module internal UnaryMetadataIlOp =
|
||||
| ResolvedBaseType.Enum
|
||||
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
|
||||
| ResolvedBaseType.Object -> SignatureTypeKind.Class
|
||||
| ResolvedBaseType.Delegate -> failwith "TODO: delegate"
|
||||
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
|
||||
|
||||
let result =
|
||||
TypeDefn.FromDefinition (
|
||||
ComparableTypeDefinitionHandle.Make defn.TypeDefHandle,
|
||||
defn.Assembly.Name,
|
||||
signatureTypeKind
|
||||
)
|
||||
if defn.Generics.IsEmpty then
|
||||
TypeDefn.FromDefinition (
|
||||
ComparableTypeDefinitionHandle.Make defn.TypeDefHandle,
|
||||
defn.Assembly.FullName,
|
||||
signatureTypeKind
|
||||
)
|
||||
else
|
||||
// Preserve the generic instantiation by converting GenericParameters to TypeDefn.GenericTypeParameter
|
||||
let genericDef =
|
||||
TypeDefn.FromDefinition (
|
||||
ComparableTypeDefinitionHandle.Make defn.TypeDefHandle,
|
||||
defn.Assembly.FullName,
|
||||
signatureTypeKind
|
||||
)
|
||||
|
||||
let genericArgs =
|
||||
defn.Generics
|
||||
|> Seq.mapi (fun i _ -> TypeDefn.GenericTypeParameter i)
|
||||
|> ImmutableArray.CreateRange
|
||||
|
||||
TypeDefn.GenericInstantiation (genericDef, genericArgs)
|
||||
|
||||
state, result, assy
|
||||
| MetadataToken.TypeSpecification spec ->
|
||||
@@ -290,6 +357,18 @@ module internal UnaryMetadataIlOp =
|
||||
| MetadataToken.TypeReference ref ->
|
||||
let ref = state.ActiveAssembly(thread).TypeRefs.[ref]
|
||||
|
||||
// Convert ConcreteTypeHandles back to TypeDefn for metadata operations
|
||||
let typeGenerics =
|
||||
newMethodState.ExecutingMethod.DeclaringType.Generics
|
||||
|> Seq.map (fun handle ->
|
||||
Concretization.concreteHandleToTypeDefn
|
||||
baseClassTypes
|
||||
handle
|
||||
state.ConcreteTypes
|
||||
state._LoadedAssemblies
|
||||
)
|
||||
|> ImmutableArray.CreateRange
|
||||
|
||||
let state, assy, resolved =
|
||||
IlMachineState.resolveTypeFromRef
|
||||
loggerFactory
|
||||
@@ -307,7 +386,7 @@ module internal UnaryMetadataIlOp =
|
||||
| ResolvedBaseType.Enum
|
||||
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
|
||||
| ResolvedBaseType.Object -> SignatureTypeKind.Class
|
||||
| ResolvedBaseType.Delegate -> failwith "TODO: delegate"
|
||||
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
|
||||
|
||||
let result =
|
||||
TypeDefn.FromDefinition (
|
||||
@@ -393,7 +472,7 @@ module internal UnaryMetadataIlOp =
|
||||
| ResolvedBaseType.Enum
|
||||
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
|
||||
| ResolvedBaseType.Object -> SignatureTypeKind.Class
|
||||
| ResolvedBaseType.Delegate -> failwith "todo"
|
||||
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
|
||||
|
||||
TypeDefn.FromDefinition (ComparableTypeDefinitionHandle.Make td, activeAssy.Name.FullName, sigType)
|
||||
| MetadataToken.TypeSpecification handle -> state.ActiveAssembly(thread).TypeSpecs.[handle].Signature
|
||||
@@ -435,7 +514,7 @@ module internal UnaryMetadataIlOp =
|
||||
|
||||
state, field
|
||||
| MetadataToken.MemberReference mr ->
|
||||
let state, _, field =
|
||||
let state, _, field, _ =
|
||||
IlMachineState.resolveMember loggerFactory baseClassTypes thread activeAssy mr state
|
||||
|
||||
match field with
|
||||
@@ -456,10 +535,8 @@ module internal UnaryMetadataIlOp =
|
||||
|
||||
let valueToStore, state = IlMachineState.popEvalStack thread state
|
||||
|
||||
let typeGenerics =
|
||||
match field.DeclaringType.Generics with
|
||||
| [] -> None
|
||||
| l -> Some (ImmutableArray.CreateRange l)
|
||||
let state, declaringTypeHandle, typeGenerics =
|
||||
IlMachineState.concretizeFieldForExecution loggerFactory baseClassTypes thread field state
|
||||
|
||||
let state, zero =
|
||||
IlMachineState.cliTypeZeroOf
|
||||
@@ -468,7 +545,7 @@ module internal UnaryMetadataIlOp =
|
||||
(state.ActiveAssembly thread)
|
||||
field.Signature
|
||||
typeGenerics
|
||||
None // field can't have its own generics
|
||||
ImmutableArray.Empty // field can't have its own generics
|
||||
state
|
||||
|
||||
let valueToStore = EvalStackValue.toCliTypeCoerced zero valueToStore
|
||||
@@ -477,7 +554,7 @@ module internal UnaryMetadataIlOp =
|
||||
|
||||
if field.Attributes.HasFlag FieldAttributes.Static then
|
||||
let state =
|
||||
IlMachineState.setStatic field.DeclaringType field.Name valueToStore state
|
||||
IlMachineState.setStatic declaringTypeHandle field.Name valueToStore state
|
||||
|
||||
state, WhatWeDid.Executed
|
||||
else
|
||||
@@ -534,7 +611,7 @@ module internal UnaryMetadataIlOp =
|
||||
|
||||
state, field
|
||||
| MetadataToken.MemberReference mr ->
|
||||
let state, _, method =
|
||||
let state, _, method, _ =
|
||||
IlMachineState.resolveMember
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
@@ -563,17 +640,15 @@ module internal UnaryMetadataIlOp =
|
||||
field.Signature
|
||||
)
|
||||
|
||||
match IlMachineState.loadClass loggerFactory baseClassTypes field.DeclaringType thread state with
|
||||
let state, declaringTypeHandle, typeGenerics =
|
||||
IlMachineState.concretizeFieldForExecution loggerFactory baseClassTypes thread field state
|
||||
|
||||
match IlMachineState.loadClass loggerFactory baseClassTypes declaringTypeHandle thread state with
|
||||
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
|
||||
| NothingToDo state ->
|
||||
|
||||
let popped, state = IlMachineState.popEvalStack thread state
|
||||
|
||||
let typeGenerics =
|
||||
match field.DeclaringType.Generics with
|
||||
| [] -> None
|
||||
| l -> Some (ImmutableArray.CreateRange l)
|
||||
|
||||
let state, zero =
|
||||
IlMachineState.cliTypeZeroOf
|
||||
loggerFactory
|
||||
@@ -581,13 +656,13 @@ module internal UnaryMetadataIlOp =
|
||||
activeAssy
|
||||
field.Signature
|
||||
typeGenerics
|
||||
None // field can't have its own generics
|
||||
ImmutableArray.Empty // field can't have its own generics
|
||||
state
|
||||
|
||||
let toStore = EvalStackValue.toCliTypeCoerced zero popped
|
||||
|
||||
let state =
|
||||
IlMachineState.setStatic field.DeclaringType field.Name toStore state
|
||||
IlMachineState.setStatic declaringTypeHandle field.Name toStore state
|
||||
|> IlMachineState.advanceProgramCounter thread
|
||||
|
||||
state, WhatWeDid.Executed
|
||||
@@ -602,7 +677,7 @@ module internal UnaryMetadataIlOp =
|
||||
|
||||
state, field
|
||||
| MetadataToken.MemberReference mr ->
|
||||
let state, assyName, field =
|
||||
let state, assyName, field, _ =
|
||||
IlMachineState.resolveMember loggerFactory baseClassTypes thread activeAssy mr state
|
||||
|
||||
match field with
|
||||
@@ -624,14 +699,15 @@ module internal UnaryMetadataIlOp =
|
||||
|
||||
let currentObj, state = IlMachineState.popEvalStack thread state
|
||||
|
||||
let typeGenerics =
|
||||
match field.DeclaringType.Generics with
|
||||
| [] -> None
|
||||
| l -> Some (ImmutableArray.CreateRange l)
|
||||
let state, declaringTypeHandle, typeGenerics =
|
||||
IlMachineState.concretizeFieldForExecution loggerFactory baseClassTypes thread field state
|
||||
|
||||
if field.Attributes.HasFlag FieldAttributes.Static then
|
||||
let declaringTypeHandle, state =
|
||||
IlMachineState.concretizeFieldDeclaringType loggerFactory baseClassTypes field.DeclaringType state
|
||||
|
||||
let state, staticField =
|
||||
match IlMachineState.getStatic field.DeclaringType field.Name state with
|
||||
match IlMachineState.getStatic declaringTypeHandle field.Name state with
|
||||
| Some v -> state, v
|
||||
| None ->
|
||||
let state, zero =
|
||||
@@ -641,10 +717,10 @@ module internal UnaryMetadataIlOp =
|
||||
(state.LoadedAssembly(field.DeclaringType.Assembly).Value)
|
||||
field.Signature
|
||||
typeGenerics
|
||||
None // field can't have its own generics
|
||||
ImmutableArray.Empty // field can't have its own generics
|
||||
state
|
||||
|
||||
let state = IlMachineState.setStatic field.DeclaringType field.Name zero state
|
||||
let state = IlMachineState.setStatic declaringTypeHandle field.Name zero state
|
||||
state, zero
|
||||
|
||||
let state = state |> IlMachineState.pushToEvalStack staticField thread
|
||||
@@ -705,7 +781,7 @@ module internal UnaryMetadataIlOp =
|
||||
|
||||
state, field
|
||||
| MetadataToken.MemberReference mr ->
|
||||
let state, _, field =
|
||||
let state, _, field, _ =
|
||||
IlMachineState.resolveMember loggerFactory baseClassTypes thread activeAssy mr state
|
||||
|
||||
match field with
|
||||
@@ -727,17 +803,15 @@ module internal UnaryMetadataIlOp =
|
||||
field.Signature
|
||||
)
|
||||
|
||||
match IlMachineState.loadClass loggerFactory baseClassTypes field.DeclaringType thread state with
|
||||
let state, declaringTypeHandle, typeGenerics =
|
||||
IlMachineState.concretizeFieldForExecution loggerFactory baseClassTypes thread field state
|
||||
|
||||
match IlMachineState.loadClass loggerFactory baseClassTypes declaringTypeHandle thread state with
|
||||
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
|
||||
| NothingToDo state ->
|
||||
|
||||
let typeGenerics =
|
||||
match field.DeclaringType.Generics with
|
||||
| [] -> None
|
||||
| l -> Some (ImmutableArray.CreateRange l)
|
||||
|
||||
let fieldValue, state =
|
||||
match IlMachineState.getStatic field.DeclaringType field.Name state with
|
||||
match IlMachineState.getStatic declaringTypeHandle field.Name state with
|
||||
| None ->
|
||||
let state, newVal =
|
||||
IlMachineState.cliTypeZeroOf
|
||||
@@ -746,10 +820,10 @@ module internal UnaryMetadataIlOp =
|
||||
activeAssy
|
||||
field.Signature
|
||||
typeGenerics
|
||||
None // field can't have its own generics
|
||||
ImmutableArray.Empty // field can't have its own generics
|
||||
state
|
||||
|
||||
newVal, IlMachineState.setStatic field.DeclaringType field.Name newVal state
|
||||
newVal, IlMachineState.setStatic declaringTypeHandle field.Name newVal state
|
||||
| Some v -> v, state
|
||||
|
||||
do
|
||||
@@ -783,9 +857,7 @@ module internal UnaryMetadataIlOp =
|
||||
let currentMethod = state.ThreadState.[thread].MethodState.ExecutingMethod
|
||||
|
||||
let declaringTypeGenerics =
|
||||
match currentMethod.DeclaringType.Generics with
|
||||
| [] -> None
|
||||
| x -> Some (ImmutableArray.CreateRange x)
|
||||
currentMethod.DeclaringType.Generics |> ImmutableArray.CreateRange
|
||||
|
||||
let state, assy, elementType =
|
||||
match metadataToken with
|
||||
@@ -793,16 +865,19 @@ module internal UnaryMetadataIlOp =
|
||||
state,
|
||||
assy,
|
||||
assy.TypeDefs.[defn]
|
||||
|> TypeInfo.mapGeneric (fun _ i -> declaringTypeGenerics.Value.[i.SequenceNumber])
|
||||
|> TypeInfo.mapGeneric (fun _ p -> TypeDefn.GenericTypeParameter p.SequenceNumber)
|
||||
| MetadataToken.TypeSpecification spec ->
|
||||
IlMachineState.resolveTypeFromSpec
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
spec
|
||||
assy
|
||||
declaringTypeGenerics
|
||||
currentMethod.Generics
|
||||
state
|
||||
let state, assy, ty =
|
||||
IlMachineState.resolveTypeFromSpecConcrete
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
spec
|
||||
assy
|
||||
declaringTypeGenerics
|
||||
currentMethod.Generics
|
||||
state
|
||||
|
||||
state, assy, ty
|
||||
| x -> failwith $"TODO: Stelem element type resolution unimplemented for {x}"
|
||||
|
||||
let contents, state = IlMachineState.popEvalStack thread state
|
||||
@@ -836,7 +911,7 @@ module internal UnaryMetadataIlOp =
|
||||
assy
|
||||
elementType
|
||||
declaringTypeGenerics
|
||||
None
|
||||
ImmutableArray.Empty
|
||||
state
|
||||
|
||||
let contents = EvalStackValue.toCliTypeCoerced zeroOfType contents
|
||||
@@ -852,9 +927,7 @@ module internal UnaryMetadataIlOp =
|
||||
let currentMethod = state.ThreadState.[thread].MethodState.ExecutingMethod
|
||||
|
||||
let declaringTypeGenerics =
|
||||
match currentMethod.DeclaringType.Generics with
|
||||
| [] -> None
|
||||
| x -> Some (ImmutableArray.CreateRange x)
|
||||
currentMethod.DeclaringType.Generics |> ImmutableArray.CreateRange
|
||||
|
||||
let state, assy, elementType =
|
||||
match metadataToken with
|
||||
@@ -862,16 +935,19 @@ module internal UnaryMetadataIlOp =
|
||||
state,
|
||||
assy,
|
||||
assy.TypeDefs.[defn]
|
||||
|> TypeInfo.mapGeneric (fun _ i -> declaringTypeGenerics.Value.[i.SequenceNumber])
|
||||
|> TypeInfo.mapGeneric (fun _ p -> TypeDefn.GenericTypeParameter p.SequenceNumber)
|
||||
| MetadataToken.TypeSpecification spec ->
|
||||
IlMachineState.resolveTypeFromSpec
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
spec
|
||||
assy
|
||||
declaringTypeGenerics
|
||||
currentMethod.Generics
|
||||
state
|
||||
let state, assy, ty =
|
||||
IlMachineState.resolveTypeFromSpecConcrete
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
spec
|
||||
assy
|
||||
declaringTypeGenerics
|
||||
currentMethod.Generics
|
||||
state
|
||||
|
||||
state, assy, ty
|
||||
| x -> failwith $"TODO: Ldelem element type resolution unimplemented for {x}"
|
||||
|
||||
let index, state = IlMachineState.popEvalStack thread state
|
||||
@@ -898,7 +974,7 @@ module internal UnaryMetadataIlOp =
|
||||
else
|
||||
failwith "TODO: raise an out of bounds"
|
||||
|
||||
failwith $"TODO: Ldelem {index} {arr} resulted in {toPush}"
|
||||
IlMachineState.pushToEvalStack toPush thread state
|
||||
|> IlMachineState.advanceProgramCounter thread
|
||||
|> Tuple.withRight WhatWeDid.Executed
|
||||
| Initobj -> failwith "TODO: Initobj unimplemented"
|
||||
@@ -916,22 +992,20 @@ module internal UnaryMetadataIlOp =
|
||||
|> FieldInfo.mapTypeGenerics (fun _ _ -> failwith "generics not allowed on FieldDefinition")
|
||||
| t -> failwith $"Unexpectedly asked to load a non-field: {t}"
|
||||
|
||||
match IlMachineState.loadClass loggerFactory baseClassTypes field.DeclaringType thread state with
|
||||
let state, declaringTypeHandle, typeGenerics =
|
||||
IlMachineState.concretizeFieldForExecution loggerFactory baseClassTypes thread field state
|
||||
|
||||
match IlMachineState.loadClass loggerFactory baseClassTypes declaringTypeHandle thread state with
|
||||
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
|
||||
| NothingToDo state ->
|
||||
|
||||
if TypeDefn.isManaged field.Signature then
|
||||
match IlMachineState.getStatic field.DeclaringType field.Name state with
|
||||
match IlMachineState.getStatic declaringTypeHandle field.Name state with
|
||||
| Some v ->
|
||||
IlMachineState.pushToEvalStack v thread state
|
||||
|> IlMachineState.advanceProgramCounter thread
|
||||
|> Tuple.withRight WhatWeDid.Executed
|
||||
| None ->
|
||||
let typeGenerics =
|
||||
match field.DeclaringType.Generics with
|
||||
| [] -> None
|
||||
| l -> Some (ImmutableArray.CreateRange l)
|
||||
|
||||
// Field is not yet initialised
|
||||
let state, zero =
|
||||
IlMachineState.cliTypeZeroOf
|
||||
@@ -940,10 +1014,10 @@ module internal UnaryMetadataIlOp =
|
||||
activeAssy
|
||||
field.Signature
|
||||
typeGenerics
|
||||
None // field can't have its own generics
|
||||
ImmutableArray.Empty // field can't have its own generics
|
||||
state
|
||||
|
||||
IlMachineState.setStatic field.DeclaringType field.Name zero state
|
||||
IlMachineState.setStatic declaringTypeHandle field.Name zero state
|
||||
|> IlMachineState.pushToEvalStack (CliType.ObjectRef None) thread
|
||||
|> IlMachineState.advanceProgramCounter thread
|
||||
|> Tuple.withRight WhatWeDid.Executed
|
||||
@@ -953,11 +1027,37 @@ module internal UnaryMetadataIlOp =
|
||||
| Ldftn ->
|
||||
let logger = loggerFactory.CreateLogger "Ldftn"
|
||||
|
||||
let method =
|
||||
let (method : MethodInfo<TypeDefn, WoofWare.PawPrint.GenericParameter, TypeDefn>), methodGenerics =
|
||||
match metadataToken with
|
||||
| MetadataToken.MethodDef handle -> activeAssy.Methods.[handle]
|
||||
| MetadataToken.MethodDef handle ->
|
||||
let method =
|
||||
activeAssy.Methods.[handle]
|
||||
|> MethodInfo.mapTypeGenerics (fun i _ -> TypeDefn.GenericTypeParameter i)
|
||||
|
||||
method, None
|
||||
| MetadataToken.MethodSpecification h ->
|
||||
let spec = activeAssy.MethodSpecs.[h]
|
||||
|
||||
match spec.Method with
|
||||
| MetadataToken.MethodDef token ->
|
||||
let method =
|
||||
activeAssy.Methods.[token]
|
||||
|> MethodInfo.mapTypeGenerics (fun i _ -> TypeDefn.GenericTypeParameter i)
|
||||
|
||||
method, Some spec.Signature
|
||||
| k -> failwith $"Unrecognised MethodSpecification kind: %O{k}"
|
||||
| t -> failwith $"Unexpectedly asked to Ldftn a non-method: {t}"
|
||||
|
||||
let state, concretizedMethod, _declaringTypeHandle =
|
||||
IlMachineState.concretizeMethodForExecution
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
thread
|
||||
method
|
||||
methodGenerics
|
||||
None
|
||||
state
|
||||
|
||||
logger.LogDebug (
|
||||
"Pushed pointer to function {LdFtnAssembly}.{LdFtnType}.{LdFtnMethodName}",
|
||||
method.DeclaringType.Assembly.Name,
|
||||
@@ -967,7 +1067,7 @@ module internal UnaryMetadataIlOp =
|
||||
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack'
|
||||
(EvalStackValue.NativeInt (NativeIntSource.FunctionPointer method))
|
||||
(EvalStackValue.NativeInt (NativeIntSource.FunctionPointer concretizedMethod))
|
||||
thread
|
||||
|> IlMachineState.advanceProgramCounter thread
|
||||
|> Tuple.withRight WhatWeDid.Executed
|
||||
@@ -999,8 +1099,7 @@ module internal UnaryMetadataIlOp =
|
||||
|
||||
let currentMethod = state.ThreadState.[thread].MethodState
|
||||
|
||||
let methodGenerics =
|
||||
currentMethod.Generics |> Option.defaultValue ImmutableArray.Empty
|
||||
let methodGenerics = currentMethod.Generics
|
||||
|
||||
let typeGenerics = currentMethod.ExecutingMethod.DeclaringType.Generics
|
||||
|
||||
|
@@ -52,11 +52,7 @@ module internal UnaryStringTokenIlOp =
|
||||
]
|
||||
|
||||
let addr, state =
|
||||
IlMachineState.allocateManagedObject
|
||||
(baseClassTypes.String
|
||||
|> TypeInfo.mapGeneric (fun _ _ -> failwith<unit> "string is not generic"))
|
||||
fields
|
||||
state
|
||||
IlMachineState.allocateManagedObject baseClassTypes.String fields state
|
||||
|
||||
addr,
|
||||
{ state with
|
||||
|
Reference in New Issue
Block a user