Concrete types - lots of tech debt in here (#79)

This commit is contained in:
Patrick Stevens
2025-07-02 22:41:13 +01:00
committed by GitHub
parent ad8e625678
commit f39e7c07bf
20 changed files with 2950 additions and 481 deletions

View File

@@ -100,3 +100,77 @@ It strongly prefers to avoid special-casing to get around problems, but instead
### Common Gotchas ### 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. * 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

View File

@@ -429,12 +429,20 @@ module Assembly =
(assemblies : ImmutableDictionary<string, DumpedAssembly>) (assemblies : ImmutableDictionary<string, DumpedAssembly>)
(referencedInAssembly : DumpedAssembly) (referencedInAssembly : DumpedAssembly)
(target : TypeRef) (target : TypeRef)
(genericArgs : ImmutableArray<TypeDefn> option) (genericArgs : ImmutableArray<TypeDefn>)
: TypeResolutionResult : TypeResolutionResult
= =
match target.ResolutionScope with match target.ResolutionScope with
| TypeRefResolutionScope.Assembly r -> | 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 let assemblyName = assemblyRef.Name
match assemblies.TryGetValue assemblyName.FullName with match assemblies.TryGetValue assemblyName.FullName with
@@ -459,13 +467,7 @@ module Assembly =
match targetType with match targetType with
| [ t ] -> | [ t ] ->
let t = let t = t |> TypeInfo.mapGeneric (fun _ param -> genericArgs.[param.SequenceNumber])
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]
)
TypeResolutionResult.Resolved (assy, t) TypeResolutionResult.Resolved (assy, t)
| _ :: _ :: _ -> failwith $"Multiple matching type definitions! {nsPath} {target.Name}" | _ :: _ :: _ -> failwith $"Multiple matching type definitions! {nsPath} {target.Name}"
@@ -480,7 +482,7 @@ module Assembly =
(assemblies : ImmutableDictionary<string, DumpedAssembly>) (assemblies : ImmutableDictionary<string, DumpedAssembly>)
(ns : string option) (ns : string option)
(name : string) (name : string)
(genericArgs : ImmutableArray<TypeDefn> option) (genericArgs : ImmutableArray<TypeDefn>)
: TypeResolutionResult : TypeResolutionResult
= =
match ns with match ns with
@@ -491,11 +493,7 @@ module Assembly =
| Some typeDef -> | Some typeDef ->
let typeDef = let typeDef =
typeDef typeDef
|> TypeInfo.mapGeneric (fun _ param -> |> TypeInfo.mapGeneric (fun _ param -> genericArgs.[param.SequenceNumber])
match genericArgs with
| None -> failwith<TypeDefn> $"tried to resolve generic type {ns}.{name} but no generics in scope"
| Some genericArgs -> genericArgs.[param.SequenceNumber]
)
TypeResolutionResult.Resolved (assy, typeDef) TypeResolutionResult.Resolved (assy, typeDef)
| None -> | None ->
@@ -512,7 +510,7 @@ module Assembly =
(fromAssembly : DumpedAssembly) (fromAssembly : DumpedAssembly)
(assemblies : ImmutableDictionary<string, DumpedAssembly>) (assemblies : ImmutableDictionary<string, DumpedAssembly>)
(ty : WoofWare.PawPrint.ExportedType) (ty : WoofWare.PawPrint.ExportedType)
(genericArgs : ImmutableArray<TypeDefn> option) (genericArgs : ImmutableArray<TypeDefn>)
: TypeResolutionResult : TypeResolutionResult
= =
match ty.Data with match ty.Data with
@@ -538,7 +536,7 @@ module DumpedAssembly =
| Some (BaseTypeInfo.TypeRef r) -> | Some (BaseTypeInfo.TypeRef r) ->
let assy = loadedAssemblies.[source.FullName] let assy = loadedAssemblies.[source.FullName]
// TODO: generics // 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 _ -> | TypeResolutionResult.FirstLoadAssy _ ->
failwith failwith
"seems pretty unlikely that we could have constructed this object without loading its base type" "seems pretty unlikely that we could have constructed this object without loading its base type"

View File

@@ -75,8 +75,6 @@ type ConcreteType<'typeGeneric when 'typeGeneric : comparison and 'typeGeneric :
(this :> IComparable<ConcreteType<'typeGeneric>>).CompareTo other (this :> IComparable<ConcreteType<'typeGeneric>>).CompareTo other
| _ -> failwith "bad comparison" | _ -> failwith "bad comparison"
type RuntimeConcreteType = ConcreteType<TypeDefn>
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module ConcreteType = module ConcreteType =
let make let make
@@ -85,7 +83,7 @@ module ConcreteType =
(name : string) (name : string)
(defn : TypeDefinitionHandle) (defn : TypeDefinitionHandle)
(generics : TypeDefn list) (generics : TypeDefn list)
: RuntimeConcreteType : ConcreteType<TypeDefn>
= =
{ {
_AssemblyName = assemblyName _AssemblyName = assemblyName

View 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)

View File

@@ -26,6 +26,7 @@
<Compile Include="ExportedType.fs" /> <Compile Include="ExportedType.fs" />
<Compile Include="TypeSpec.fs" /> <Compile Include="TypeSpec.fs" />
<Compile Include="Assembly.fs" /> <Compile Include="Assembly.fs" />
<Compile Include="TypeConcretisation.fs" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>

View File

@@ -16,6 +16,18 @@ module TestPureCases =
let unimplemented = 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" FileName = "TestShl.cs"
ExpectedReturnCode = 0 ExpectedReturnCode = 0
@@ -80,6 +92,12 @@ module TestPureCases =
NativeImpls = MockEnv.make () NativeImpls = MockEnv.make ()
LocalVariablesOfMain = [ CliType.Numeric (CliNumericType.Int32 1) ] |> Some LocalVariablesOfMain = [ CliType.Numeric (CliNumericType.Int32 1) ] |> Some
} }
{
FileName = "StaticVariables.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
LocalVariablesOfMain = None
}
{ {
FileName = "Ldind.cs" FileName = "Ldind.cs"
ExpectedReturnCode = 0 ExpectedReturnCode = 0
@@ -200,6 +218,12 @@ module TestPureCases =
NativeImpls = MockEnv.make () NativeImpls = MockEnv.make ()
LocalVariablesOfMain = None LocalVariablesOfMain = None
} }
{
FileName = "TypeConcretization.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
LocalVariablesOfMain = None
}
{ {
FileName = "TestOr.cs" FileName = "TestOr.cs"
ExpectedReturnCode = 0 ExpectedReturnCode = 0

View File

@@ -22,6 +22,7 @@
<EmbeddedResource Include="sourcesPure\BasicLock.cs" /> <EmbeddedResource Include="sourcesPure\BasicLock.cs" />
<EmbeddedResource Include="sourcesPure\Floats.cs" /> <EmbeddedResource Include="sourcesPure\Floats.cs" />
<EmbeddedResource Include="sourcesPure\NoOp.cs" /> <EmbeddedResource Include="sourcesPure\NoOp.cs" />
<EmbeddedResource Include="sourcesPure\StaticVariables.cs" />
<EmbeddedResource Include="sourcesPure\Ldelema.cs" /> <EmbeddedResource Include="sourcesPure\Ldelema.cs" />
<EmbeddedResource Include="sourcesPure\ExceptionWithNoOpCatch.cs" /> <EmbeddedResource Include="sourcesPure\ExceptionWithNoOpCatch.cs" />
<EmbeddedResource Include="sourcesPure\ExceptionWithNoOpFinally.cs" /> <EmbeddedResource Include="sourcesPure\ExceptionWithNoOpFinally.cs" />
@@ -36,6 +37,9 @@
<EmbeddedResource Include="sourcesPure\TestOr.cs" /> <EmbeddedResource Include="sourcesPure\TestOr.cs" />
<EmbeddedResource Include="sourcesPure\CustomDelegate.cs" /> <EmbeddedResource Include="sourcesPure\CustomDelegate.cs" />
<EmbeddedResource Include="sourcesPure\Ldind.cs" /> <EmbeddedResource Include="sourcesPure\Ldind.cs" />
<EmbeddedResource Include="sourcesPure\TypeConcretization.cs" />
<EmbeddedResource Include="sourcesPure\CrossAssemblyTypes.cs" />
<EmbeddedResource Include="sourcesPure\GenericEdgeCases.cs" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<EmbeddedResource Include="sourcesImpure\WriteLine.cs" /> <EmbeddedResource Include="sourcesImpure\WriteLine.cs" />

View 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
}
}

View 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
}
}

View 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;
}
}

View 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
}
}

View File

@@ -60,22 +60,18 @@ module AbstractMachine =
let delegateToRun = state.ManagedHeap.NonArrayObjects.[delegateToRunAddr] let delegateToRun = state.ManagedHeap.NonArrayObjects.[delegateToRunAddr]
if delegateToRun.Fields.["_target"] <> CliType.ObjectRef None then let target =
failwith "TODO: delegate target wasn't None" match delegateToRun.Fields.["_target"] with
| CliType.ObjectRef addr -> addr
| x -> failwith $"TODO: delegate target wasn't an object ref: %O{x}"
let methodPtr = let methodPtr =
match delegateToRun.Fields.["_methodPtr"] with match delegateToRun.Fields.["_methodPtr"] with
| CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.FunctionPointer mi)) -> mi | CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.FunctionPointer mi)) -> mi
| d -> failwith $"unexpectedly not a method pointer in delegate invocation: {d}" | 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 methodGenerics = instruction.ExecutingMethod.Generics
let methodPtr =
methodPtr |> MethodInfo.mapTypeGenerics (fun i _ -> typeGenerics.[i])
// When we return, we need to go back up the stack // When we return, we need to go back up the stack
match state |> IlMachineState.returnStackFrame loggerFactory baseClassTypes thread with match state |> IlMachineState.returnStackFrame loggerFactory baseClassTypes thread with
| None -> failwith "unexpectedly nowhere to return from delegate" | None -> failwith "unexpectedly nowhere to return from delegate"
@@ -86,23 +82,41 @@ module AbstractMachine =
(state, instruction.Arguments) (state, instruction.Arguments)
||> Seq.fold (fun state arg -> IlMachineState.pushToEvalStack arg thread state) ||> 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, _ = let state, _ =
state.WithThreadSwitchedToAssembly methodPtr.DeclaringType.Assembly thread state.WithThreadSwitchedToAssembly methodPtr.DeclaringType.Assembly thread
// Don't advance the program counter again on return; that was already done by the Callvirt that // Don't advance the program counter again on return; that was already done by the Callvirt that
// caused this delegate to be invoked. // caused this delegate to be invoked.
let state, result = let currentThreadState = state.ThreadState.[thread]
state
|> IlMachineState.callMethodInActiveAssembly let state =
IlMachineState.callMethod
loggerFactory loggerFactory
baseClassTypes baseClassTypes
thread
false
(Some methodGenerics)
methodPtr
None None
constructing
false
false
methodGenerics
methodPtr
thread
currentThreadState
state
ExecutionResult.Stepped (state, result) ExecutionResult.Stepped (state, WhatWeDid.Executed)
| _ -> | _ ->
let outcome = let outcome =
@@ -111,8 +125,8 @@ module AbstractMachine =
targetType.Namespace, targetType.Namespace,
targetType.Name, targetType.Name,
instruction.ExecutingMethod.Name, instruction.ExecutingMethod.Name,
instruction.ExecutingMethod.Signature.ParameterTypes, instruction.ExecutingMethod.RawSignature.ParameterTypes,
instruction.ExecutingMethod.Signature.ReturnType instruction.ExecutingMethod.RawSignature.ReturnType
with with
| "System.Private.CoreLib", | "System.Private.CoreLib",
"System", "System",

View File

@@ -1,6 +1,5 @@
namespace WoofWare.PawPrint namespace WoofWare.PawPrint
open System
open System.Collections.Immutable open System.Collections.Immutable
open System.Reflection open System.Reflection
open System.Reflection.Metadata open System.Reflection.Metadata
@@ -63,7 +62,7 @@ type UnsignedNativeIntSource =
type NativeIntSource = type NativeIntSource =
| Verbatim of int64 | Verbatim of int64
| ManagedPointer of ManagedPointerSource | ManagedPointer of ManagedPointerSource
| FunctionPointer of MethodInfo<FakeUnit, WoofWare.PawPrint.GenericParameter, TypeDefn> | FunctionPointer of MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle>
| TypeHandlePtr of int64<typeHandle> | TypeHandlePtr of int64<typeHandle>
override this.ToString () : string = override this.ToString () : string =
@@ -168,7 +167,6 @@ type CliTypeResolutionResult =
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module CliType = module CliType =
let zeroOfPrimitive (primitiveType : PrimitiveType) : CliType = let zeroOfPrimitive (primitiveType : PrimitiveType) : CliType =
match primitiveType with match primitiveType with
| PrimitiveType.Boolean -> CliType.Bool 0uy | PrimitiveType.Boolean -> CliType.Bool 0uy
@@ -194,92 +192,208 @@ module CliType =
| PrimitiveType.Object -> CliType.ObjectRef None | PrimitiveType.Object -> CliType.ObjectRef None
let rec zeroOf let rec zeroOf
(concreteTypes : AllConcreteTypes)
(assemblies : ImmutableDictionary<string, DumpedAssembly>) (assemblies : ImmutableDictionary<string, DumpedAssembly>)
(corelib : BaseClassTypes<DumpedAssembly>) (corelib : BaseClassTypes<DumpedAssembly>)
(assy : DumpedAssembly) (handle : ConcreteTypeHandle)
(typeGenerics : TypeDefn ImmutableArray option) : CliType * AllConcreteTypes
(methodGenerics : TypeDefn ImmutableArray option)
(ty : TypeDefn)
: CliTypeResolutionResult
= =
match ty with zeroOfWithVisited concreteTypes assemblies corelib handle Set.empty
| 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
match fields with and zeroOfWithVisited
| Error (_, []) -> failwith "logic error" (concreteTypes : AllConcreteTypes)
| Error (_, f :: _) -> CliTypeResolutionResult.FirstLoad f (assemblies : ImmutableDictionary<string, DumpedAssembly>)
| Ok fields -> CliType.ValueType fields |> CliTypeResolutionResult.Resolved (corelib : BaseClassTypes<DumpedAssembly>)
| TypeResolutionResult.FirstLoadAssy assy -> CliTypeResolutionResult.FirstLoad assy (handle : ConcreteTypeHandle)
| SignatureTypeKind.Class -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved (visited : Set<ConcreteTypeHandle>)
| _ -> raise (ArgumentOutOfRangeException ()) : CliType * AllConcreteTypes
| TypeDefn.FromDefinition (typeDefinitionHandle, _, signatureTypeKind) -> =
let typeDef = assy.TypeDefs.[typeDefinitionHandle.Get]
if typeDef = corelib.Int32 then // Handle constructed types first
zeroOfPrimitive PrimitiveType.Int32 |> CliTypeResolutionResult.Resolved match handle with
elif typeDef = corelib.Int64 then | ConcreteTypeHandle.Byref _ ->
zeroOfPrimitive PrimitiveType.Int64 |> CliTypeResolutionResult.Resolved // Byref types are managed references - the zero value is a null reference
elif typeDef = corelib.UInt32 then CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null), concreteTypes
zeroOfPrimitive PrimitiveType.UInt32 |> CliTypeResolutionResult.Resolved
elif typeDef = corelib.UInt64 then | ConcreteTypeHandle.Pointer _ ->
zeroOfPrimitive PrimitiveType.UInt64 |> CliTypeResolutionResult.Resolved // 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 else
// TODO: the rest let visited = Set.add handle visited
match signatureTypeKind with // Not a known primitive, check if it's a value type or reference type
| SignatureTypeKind.Unknown -> failwith "todo" determineZeroForCustomType concreteTypes assemblies corelib handle concreteType typeDef visited
| SignatureTypeKind.ValueType -> else if
let fields = // 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
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
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
=
// 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 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.filter (fun field -> not (field.Attributes.HasFlag FieldAttributes.Static))
|> List.map (fun fi -> |> List.map (fun field ->
match zeroOf assemblies corelib assy typeGenerics methodGenerics fi.Signature with // Need to concretize the field type with the concrete type's generics
| CliTypeResolutionResult.Resolved ty -> Ok (fi.Name, ty) let fieldTypeDefn = field.Signature
| CliTypeResolutionResult.FirstLoad a -> Error a
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)
) )
|> Result.allOkOrError
match fields with CliType.ValueType fieldZeros, currentConcreteTypes
| Error (_, []) -> failwith "logic error" else
| Error (_, f :: _) -> CliTypeResolutionResult.FirstLoad f // It's a reference type
| Ok fields -> CliType.ObjectRef None, concreteTypes
CliType.ValueType fields |> CliTypeResolutionResult.Resolved and private concretizeFieldType
| SignatureTypeKind.Class -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved (concreteTypes : AllConcreteTypes)
| _ -> raise (ArgumentOutOfRangeException ()) (assemblies : ImmutableDictionary<string, DumpedAssembly>)
| TypeDefn.GenericInstantiation (generic, args) -> (corelib : BaseClassTypes<DumpedAssembly>)
zeroOf assemblies corelib assy (Some args) methodGenerics generic (declaringType : ConcreteType<ConcreteTypeHandle>)
| TypeDefn.FunctionPointer typeMethodSignature -> failwith "todo" (fieldType : TypeDefn)
| TypeDefn.GenericTypeParameter index -> : ConcreteTypeHandle * AllConcreteTypes
// 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" // Create a concretization context
| Some generics -> zeroOf assemblies corelib assy (Some generics) methodGenerics generics.[index] let ctx =
| TypeDefn.GenericMethodParameter index -> {
match methodGenerics with TypeConcretization.ConcretizationContext.InProgress = ImmutableDictionary.Empty
| None -> failwith "asked for a method parameter of generic type, but no generics in scope" TypeConcretization.ConcretizationContext.ConcreteTypes = concreteTypes
| Some generics -> zeroOf assemblies corelib assy typeGenerics (Some generics) generics.[index] TypeConcretization.ConcretizationContext.LoadedAssemblies = assemblies
| TypeDefn.Void -> failwith "should never construct an element of type Void" 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

View File

@@ -6,7 +6,7 @@ type MethodReturnState =
{ {
/// Index in the MethodStates array of a ThreadState /// Index in the MethodStates array of a ThreadState
JumpTo : int JumpTo : int
WasInitialisingType : RuntimeConcreteType option WasInitialisingType : ConcreteTypeHandle option
/// The Newobj instruction means we need to push a reference immediately after Ret. /// The Newobj instruction means we need to push a reference immediately after Ret.
WasConstructingObj : ManagedHeapAddress option WasConstructingObj : ManagedHeapAddress option
} }
@@ -19,16 +19,16 @@ and MethodState =
_IlOpIndex : int _IlOpIndex : int
EvaluationStack : EvalStack EvaluationStack : EvalStack
Arguments : CliType ImmutableArray 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 /// We don't implement the local memory pool right now
LocalMemoryPool : unit LocalMemoryPool : unit
/// On return, we restore this state. This should be Some almost always; an exception is the entry point. /// On return, we restore this state. This should be Some almost always; an exception is the entry point.
ReturnState : MethodReturnState option ReturnState : MethodReturnState option
Generics : ImmutableArray<TypeDefn> option Generics : ImmutableArray<ConcreteTypeHandle>
/// Track which exception regions are currently active (innermost first) /// Track which exception regions are currently active (innermost first)
ActiveExceptionRegions : ExceptionRegion list ActiveExceptionRegions : ExceptionRegion list
/// When executing a finally/fault/filter, we need to know where to return /// 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 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 an instance method, `args` must be of length 1+numParams.
/// If `method` is static, `args` must be of length numParams. /// If `method` is static, `args` must be of length numParams.
static member Empty static member Empty
(concreteTypes : AllConcreteTypes)
(corelib : BaseClassTypes<DumpedAssembly>) (corelib : BaseClassTypes<DumpedAssembly>)
(loadedAssemblies : ImmutableDictionary<string, DumpedAssembly>) (loadedAssemblies : ImmutableDictionary<string, DumpedAssembly>)
(containingAssembly : DumpedAssembly) (containingAssembly : DumpedAssembly)
(method : WoofWare.PawPrint.MethodInfo<TypeDefn, TypeDefn, TypeDefn>) (method : WoofWare.PawPrint.MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle>)
(methodGenerics : ImmutableArray<TypeDefn> option) (methodGenerics : ImmutableArray<ConcreteTypeHandle>)
(args : ImmutableArray<CliType>) (args : ImmutableArray<CliType>)
(returnState : MethodReturnState option) (returnState : MethodReturnState option)
: Result<MethodState, WoofWare.PawPrint.AssemblyReference list> : 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 // I think valid code should remain valid if we unconditionally localsInit - it should be undefined
// to use an uninitialised value? Not checked this; TODO. // 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 localVars =
let result = ImmutableArray.CreateBuilder () let result = ImmutableArray.CreateBuilder ()
for var in localVariableSig do for var in localVariableSig do
match CliType.zeroOf loadedAssemblies corelib containingAssembly typeGenerics methodGenerics var with // Note: This assumes all types have already been concretized
| CliTypeResolutionResult.Resolved t -> result.Add t // If this fails with "ConcreteTypeHandle not found", it means
| CliTypeResolutionResult.FirstLoad (assy : WoofWare.PawPrint.AssemblyReference) -> // we need to ensure types are concretized before creating the MethodState
requiredAssemblies.Add assy let zero, _ = CliType.zeroOf concreteTypes loadedAssemblies corelib var
result.Add zero
result.ToImmutable () result.ToImmutable ()
if requiredAssemblies.Count > 0 then
Error (requiredAssemblies |> Seq.toList)
else
let activeRegions = ExceptionHandling.getActiveRegionsAtOffset 0 method let activeRegions = ExceptionHandling.getActiveRegionsAtOffset 0 method
{ {

View File

@@ -17,11 +17,7 @@ module Program =
let argsAllocations, state = let argsAllocations, state =
(state, args) (state, args)
||> Seq.mapFold (fun state arg -> ||> Seq.mapFold (fun state arg ->
IlMachineState.allocateManagedObject IlMachineState.allocateManagedObject corelib.String (failwith "TODO: assert fields and populate") state
(corelib.String
|> TypeInfo.mapGeneric (fun _ _ -> failwith<unit> "there are no generics here"))
(failwith "TODO: assert fields and populate")
state
// TODO: set the char values in memory // TODO: set the char values in memory
) )
@@ -83,71 +79,177 @@ module Program =
| None -> failwith "No entry point in input DLL" | None -> failwith "No entry point in input DLL"
| Some d -> d | 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" failwith "Refusing to execute generic main method"
let mainMethod = let state = IlMachineState.initial loggerFactory dotnetRuntimeDirs dumped
mainMethod
|> MethodInfo.mapTypeGenerics (fun _ -> failwith "Refusing to execute generic main method") // Find the core library by traversing the type hierarchy of the main method's declaring type
|> MethodInfo.mapMethodGenerics (fun _ -> failwith "Refusing to execute generic main method") // 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
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) = 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 match baseClassTypes with
// executing the main method. | Some baseTypes ->
// We construct the thread here before we are entirely ready, because we need a thread from which to // We already have base class types, can directly create the concretized method
// initialise the class containing the main method. // Use the original method from metadata, but convert FakeUnit to TypeDefn
// Once we've obtained e.g. the String and Array classes, we can populate the args array. let rawMainMethod =
match mainMethodFromMetadata
MethodState.Empty |> MethodInfo.mapTypeGenerics (fun i _ -> TypeDefn.GenericTypeParameter i)
(Option.toObj baseClassTypes)
state._LoadedAssemblies let state, concretizedMainMethod, _ =
dumped IlMachineState.concretizeMethodWithTypeGenerics
// pretend there are no instructions, so we avoid preparing anything loggerFactory
{ mainMethod with baseTypes
ImmutableArray.Empty // No type generics for main method's declaring type
{ rawMainMethod with
Instructions = Some (MethodInstructions.onlyRet ()) Instructions = Some (MethodInstructions.onlyRet ())
} }
None None
dumped.Name
ImmutableArray.Empty
state
// 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 ]) (ImmutableArray.CreateRange [ CliType.ObjectRef None ])
None None
with with
| Ok meth -> IlMachineState.addThread meth dumped.Name state, baseClassTypes | Ok concretizedMeth -> IlMachineState.addThread concretizedMeth dumped.Name state, Some baseTypes
| Error requiresRefs -> | Error _ -> failwith "Unexpected failure creating method state with concretized method"
let state = | None ->
(state, requiresRefs) // We need to discover the core library by traversing the type hierarchy
||> List.fold (fun state ref -> let mainMethodType =
let handle, referencingAssy = ref.Handle dumped.TypeDefs.[mainMethodFromMetadata.DeclaringType.Definition.Get]
let referencingAssy = state.LoadedAssembly referencingAssy |> Option.get
let state, _, _ = let state, baseTypes =
IlMachineState.loadAssembly loggerFactory referencingAssy handle state findCoreLibraryAssemblyFromGeneric state mainMethodType dumped
computeState baseTypes state
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 state
) | None -> failwith "Expected base class types to be available at this point"
let corelib =
let coreLib =
state._LoadedAssemblies.Keys
|> Seq.tryFind (fun x -> x.StartsWith ("System.Private.CoreLib, ", StringComparison.Ordinal))
coreLib
|> Option.map (fun coreLib -> state._LoadedAssemblies.[coreLib] |> Corelib.getBaseTypes)
computeState corelib state
let (state, mainThread), baseClassTypes =
IlMachineState.initial loggerFactory dotnetRuntimeDirs dumped
|> computeState None
let rec loadInitialState (state : IlMachineState) = let rec loadInitialState (state : IlMachineState) =
match match
state state
|> IlMachineState.loadClass |> IlMachineState.loadClass loggerFactory (Option.toObj baseClassTypes) mainTypeHandle mainThread
loggerFactory
(Option.toObj baseClassTypes)
mainMethod.DeclaringType
mainThread
with with
| StateLoadResult.NothingToDo ilMachineState -> ilMachineState | StateLoadResult.NothingToDo ilMachineState -> ilMachineState
| StateLoadResult.FirstLoadThis ilMachineState -> loadInitialState ilMachineState | StateLoadResult.FirstLoadThis ilMachineState -> loadInitialState ilMachineState
@@ -167,12 +269,12 @@ module Program =
| Some c -> c | Some c -> c
let arrayAllocation, state = let arrayAllocation, state =
match mainMethod.Signature.ParameterTypes |> Seq.toList with match mainMethodFromMetadata.Signature.ParameterTypes |> Seq.toList with
| [ TypeDefn.OneDimensionalArrayLowerBoundZero (TypeDefn.PrimitiveType PrimitiveType.String) ] -> | [ TypeDefn.OneDimensionalArrayLowerBoundZero (TypeDefn.PrimitiveType PrimitiveType.String) ] ->
allocateArgs argv baseClassTypes state allocateArgs argv baseClassTypes state
| _ -> failwith "Main method must take an array of strings; other signatures not yet implemented" | _ -> 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 -> () | TypeDefn.PrimitiveType PrimitiveType.Int32 -> ()
| _ -> failwith "Main method must return int32; other types not currently supported" | _ -> failwith "Main method must return int32; other types not currently supported"
@@ -185,15 +287,16 @@ module Program =
logger.LogInformation "Main method class now initialised" logger.LogInformation "Main method class now initialised"
// Now that BCL initialisation has taken place and the user-code classes are constructed, // 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 = let methodState =
match match
MethodState.Empty MethodState.Empty
state.ConcreteTypes
baseClassTypes baseClassTypes
state._LoadedAssemblies state._LoadedAssemblies
dumped dumped
mainMethod concretizedMainMethod
None ImmutableArray.Empty
(ImmutableArray.Create (CliType.OfManagedObject arrayAllocation)) (ImmutableArray.Create (CliType.OfManagedObject arrayAllocation))
None None
with with
@@ -210,11 +313,7 @@ module Program =
{ state with { state with
ThreadState = state.ThreadState |> Map.add mainThread threadState ThreadState = state.ThreadState |> Map.add mainThread threadState
} }
|> IlMachineState.ensureTypeInitialised |> IlMachineState.ensureTypeInitialised loggerFactory baseClassTypes mainThread mainTypeHandle
loggerFactory
baseClassTypes
mainThread
methodState.ExecutingMethod.DeclaringType
match init with match init with
| WhatWeDid.SuspendedForClassInit -> failwith "TODO: suspended for class init" | WhatWeDid.SuspendedForClassInit -> failwith "TODO: suspended for class init"

View File

@@ -4,3 +4,5 @@ namespace WoofWare.PawPrint
module internal Tuple = module internal Tuple =
let withLeft<'a, 'b> (x : 'a) (y : 'b) : 'a * 'b = x, y let withLeft<'a, 'b> (x : 'a) (y : 'b) : 'a * 'b = x, y
let withRight<'a, 'b> (y : 'b) (x : 'a) = 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

View File

@@ -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. /// 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. // 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>] [<RequireQualifiedAccess>]
module TypeInitTable = module TypeInitTable =
let tryGet (ty : RuntimeConcreteType) (t : TypeInitTable) = let tryGet (ty : ConcreteTypeHandle) (t : TypeInitTable) =
match t.TryGetValue ty with match t.TryGetValue ty with
| true, v -> Some v | true, v -> Some v
| false, _ -> None | 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 match t.TryGetValue ty with
| false, _ -> t.Add (ty, TypeInitState.InProgress thread) | false, _ -> t.Add (ty, TypeInitState.InProgress thread)
| true, v -> failwith "Logic error: tried initialising a type which has already started initialising" | 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 match t.TryGetValue ty with
| false, _ -> failwith "Logic error: completing initialisation of a type which never started initialising" | false, _ -> failwith "Logic error: completing initialisation of a type which never started initialising"
| true, TypeInitState.Initialized -> | true, TypeInitState.Initialized ->

View File

@@ -20,7 +20,7 @@ module internal UnaryMetadataIlOp =
match op with match op with
| Call -> | Call ->
let state, methodToCall, methodGenerics = let state, methodToCall, methodGenerics, typeArgsFromMetadata =
match metadataToken with match metadataToken with
| MetadataToken.MethodSpecification h -> | MetadataToken.MethodSpecification h ->
let spec = activeAssy.MethodSpecs.[h] let spec = activeAssy.MethodSpecs.[h]
@@ -29,11 +29,11 @@ module internal UnaryMetadataIlOp =
| MetadataToken.MethodDef token -> | MetadataToken.MethodDef token ->
let method = let method =
activeAssy.Methods.[token] 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 -> | MetadataToken.MemberReference ref ->
let state, _, method = let state, _, method, extractedTypeArgs =
IlMachineState.resolveMember IlMachineState.resolveMember
loggerFactory loggerFactory
baseClassTypes baseClassTypes
@@ -44,10 +44,10 @@ module internal UnaryMetadataIlOp =
match method with match method with
| Choice2Of2 _field -> failwith "tried to Call a field" | 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}" | k -> failwith $"Unrecognised kind: %O{k}"
| MetadataToken.MemberReference h -> | MetadataToken.MemberReference h ->
let state, _, method = let state, _, method, extractedTypeArgs =
IlMachineState.resolveMember IlMachineState.resolveMember
loggerFactory loggerFactory
baseClassTypes baseClassTypes
@@ -58,18 +58,114 @@ module internal UnaryMetadataIlOp =
match method with match method with
| Choice2Of2 _field -> failwith "tried to Call a field" | Choice2Of2 _field -> failwith "tried to Call a field"
| Choice1Of2 method -> state, method, None | Choice1Of2 method -> state, method, None, Some extractedTypeArgs
| MetadataToken.MethodDef defn -> | MetadataToken.MethodDef defn ->
match activeAssy.Methods.TryGetValue defn with match activeAssy.Methods.TryGetValue defn with
| true, method -> | true, method ->
let method = method |> MethodInfo.mapTypeGenerics (fun _ -> failwith "not generic") 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}" | false, _ -> failwith $"could not find method in {activeAssy.Name}"
| k -> failwith $"Unrecognised kind: %O{k}" | k -> failwith $"Unrecognised kind: %O{k}"
match IlMachineState.loadClass loggerFactory baseClassTypes methodToCall.DeclaringType thread state with let state, concretizedMethod, declaringTypeHandle =
IlMachineState.concretizeMethodForExecution
loggerFactory
baseClassTypes
thread
methodToCall
methodGenerics
typeArgsFromMetadata
state
match IlMachineState.loadClass loggerFactory baseClassTypes declaringTypeHandle thread state with
| NothingToDo state -> | 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, methodToCall, methodGenerics, typeArgsFromMetadata =
match metadataToken with
| MetadataToken.MethodSpecification h ->
let spec = activeAssy.MethodSpecs.[h]
match spec.Method with
| MetadataToken.MethodDef token ->
let method =
activeAssy.Methods.[token]
|> MethodInfo.mapTypeGenerics (fun i _ -> spec.Signature.[i])
state, method, Some spec.Signature, None
| MetadataToken.MemberReference ref ->
let state, _, method, extractedTypeArgs =
IlMachineState.resolveMember
loggerFactory
baseClassTypes
thread
(state.ActiveAssembly thread)
ref
state
match method with
| Choice2Of2 _field -> failwith "tried to Callvirt a field"
| Choice1Of2 method -> state, method, Some spec.Signature, Some extractedTypeArgs
| k -> failwith $"Unrecognised kind: %O{k}"
| MetadataToken.MemberReference h ->
let state, _, method, extractedTypeArgs =
IlMachineState.resolveMember
loggerFactory
baseClassTypes
thread
(state.ActiveAssembly thread)
h
state
match method with
| Choice2Of2 _field -> failwith "tried to Callvirt a field"
| 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, None
| false, _ -> failwith $"could not find method in {activeAssy.Name}"
| k -> failwith $"Unrecognised kind: %O{k}"
// 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 methodToCall.DeclaringType.Assembly thread state.WithThreadSwitchedToAssembly methodToCall.DeclaringType.Assembly thread
|> fst |> fst
|> IlMachineState.callMethodInActiveAssembly |> IlMachineState.callMethodInActiveAssembly
@@ -80,78 +176,23 @@ module internal UnaryMetadataIlOp =
methodGenerics methodGenerics
methodToCall methodToCall
None None
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit typeArgsFromMetadata
| Callvirt ->
// TODO: this is presumably super incomplete
let state, method, generics =
match metadataToken with
| MetadataToken.MethodSpecification h ->
let spec = activeAssy.MethodSpecs.[h]
match spec.Method with
| MetadataToken.MethodDef token ->
let method =
activeAssy.Methods.[token]
|> MethodInfo.mapTypeGenerics (fun i _ -> spec.Signature.[i])
state, method, Some spec.Signature
| MetadataToken.MemberReference ref ->
let state, _, method =
IlMachineState.resolveMember
loggerFactory
baseClassTypes
thread
(state.ActiveAssembly thread)
ref
state
match method with
| Choice2Of2 _field -> failwith "tried to Callvirt a field"
| Choice1Of2 method -> state, method, Some spec.Signature
| k -> failwith $"Unrecognised kind: %O{k}"
| MetadataToken.MemberReference h ->
let state, _, method =
IlMachineState.resolveMember
loggerFactory
baseClassTypes
thread
(state.ActiveAssembly thread)
h
state
match method with
| Choice2Of2 _field -> failwith "tried to Callvirt a field"
| Choice1Of2 method -> state, method, None
| MetadataToken.MethodDef defn ->
match activeAssy.Methods.TryGetValue defn with
| true, method ->
let method = method |> MethodInfo.mapTypeGenerics (fun _ -> failwith "not generic")
state, method, 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
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| NothingToDo state ->
state.WithThreadSwitchedToAssembly method.DeclaringType.Assembly thread
|> fst
|> IlMachineState.callMethodInActiveAssembly loggerFactory baseClassTypes thread true generics method None
| Castclass -> failwith "TODO: Castclass unimplemented" | Castclass -> failwith "TODO: Castclass unimplemented"
| Newobj -> | Newobj ->
let logger = loggerFactory.CreateLogger "Newobj" let logger = loggerFactory.CreateLogger "Newobj"
let state, assy, ctor = let state, assy, ctor, typeArgsFromMetadata =
match metadataToken with match metadataToken with
| MethodDef md -> | MethodDef md ->
let method = activeAssy.Methods.[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 -> | MemberReference mr ->
let state, name, method = let state, name, method, extractedTypeArgs =
IlMachineState.resolveMember IlMachineState.resolveMember
loggerFactory loggerFactory
baseClassTypes baseClassTypes
@@ -161,12 +202,24 @@ module internal UnaryMetadataIlOp =
state state
match method with 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" | Choice2Of2 _field -> failwith "unexpectedly NewObj found a constructor which is a field"
| x -> failwith $"Unexpected metadata token for constructor: %O{x}" | 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 = let state, init =
IlMachineState.ensureTypeInitialised loggerFactory baseClassTypes thread ctor.DeclaringType state IlMachineState.ensureTypeInitialised loggerFactory baseClassTypes thread declaringTypeHandle state
match init with match init with
| WhatWeDid.BlockedOnClassInit state -> failwith "TODO: another thread is running the initialiser" | WhatWeDid.BlockedOnClassInit state -> failwith "TODO: another thread is running the initialiser"
@@ -184,9 +237,7 @@ module internal UnaryMetadataIlOp =
) )
let typeGenerics = let typeGenerics =
match ctor.DeclaringType.Generics with concretizedCtor.DeclaringType.Generics |> ImmutableArray.CreateRange
| [] -> None
| l -> Some (ImmutableArray.CreateRange l)
let state, fieldZeros = let state, fieldZeros =
((state, []), ctorType.Fields) ((state, []), ctorType.Fields)
@@ -199,7 +250,7 @@ module internal UnaryMetadataIlOp =
ctorAssembly ctorAssembly
field.Signature field.Signature
typeGenerics typeGenerics
None ImmutableArray.Empty
state state
state, (field.Name, zero) :: zeros state, (field.Name, zero) :: zeros
@@ -232,6 +283,7 @@ module internal UnaryMetadataIlOp =
None None
ctor ctor
(Some allocatedAddr) (Some allocatedAddr)
typeArgsFromMetadata
match whatWeDid with match whatWeDid with
| SuspendedForClassInit -> failwith "unexpectedly suspended while initialising constructor" | 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" | popped -> failwith $"unexpectedly popped value %O{popped} to serve as array len"
let typeGenerics = let typeGenerics =
match newMethodState.ExecutingMethod.DeclaringType.Generics with newMethodState.ExecutingMethod.DeclaringType.Generics
| [] -> None |> ImmutableArray.CreateRange
| l -> Some (ImmutableArray.CreateRange l)
let state, elementType, assy = let state, elementType, assy =
match metadataToken with match metadataToken with
@@ -274,14 +325,30 @@ module internal UnaryMetadataIlOp =
| ResolvedBaseType.Enum | ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType | ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object -> SignatureTypeKind.Class | ResolvedBaseType.Object -> SignatureTypeKind.Class
| ResolvedBaseType.Delegate -> failwith "TODO: delegate" | ResolvedBaseType.Delegate -> SignatureTypeKind.Class
let result = let result =
if defn.Generics.IsEmpty then
TypeDefn.FromDefinition ( TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make defn.TypeDefHandle, ComparableTypeDefinitionHandle.Make defn.TypeDefHandle,
defn.Assembly.Name, defn.Assembly.FullName,
signatureTypeKind 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 state, result, assy
| MetadataToken.TypeSpecification spec -> | MetadataToken.TypeSpecification spec ->
@@ -290,6 +357,18 @@ module internal UnaryMetadataIlOp =
| MetadataToken.TypeReference ref -> | MetadataToken.TypeReference ref ->
let ref = state.ActiveAssembly(thread).TypeRefs.[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 = let state, assy, resolved =
IlMachineState.resolveTypeFromRef IlMachineState.resolveTypeFromRef
loggerFactory loggerFactory
@@ -307,7 +386,7 @@ module internal UnaryMetadataIlOp =
| ResolvedBaseType.Enum | ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType | ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object -> SignatureTypeKind.Class | ResolvedBaseType.Object -> SignatureTypeKind.Class
| ResolvedBaseType.Delegate -> failwith "TODO: delegate" | ResolvedBaseType.Delegate -> SignatureTypeKind.Class
let result = let result =
TypeDefn.FromDefinition ( TypeDefn.FromDefinition (
@@ -393,7 +472,7 @@ module internal UnaryMetadataIlOp =
| ResolvedBaseType.Enum | ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType | ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object -> SignatureTypeKind.Class | ResolvedBaseType.Object -> SignatureTypeKind.Class
| ResolvedBaseType.Delegate -> failwith "todo" | ResolvedBaseType.Delegate -> SignatureTypeKind.Class
TypeDefn.FromDefinition (ComparableTypeDefinitionHandle.Make td, activeAssy.Name.FullName, sigType) TypeDefn.FromDefinition (ComparableTypeDefinitionHandle.Make td, activeAssy.Name.FullName, sigType)
| MetadataToken.TypeSpecification handle -> state.ActiveAssembly(thread).TypeSpecs.[handle].Signature | MetadataToken.TypeSpecification handle -> state.ActiveAssembly(thread).TypeSpecs.[handle].Signature
@@ -435,7 +514,7 @@ module internal UnaryMetadataIlOp =
state, field state, field
| MetadataToken.MemberReference mr -> | MetadataToken.MemberReference mr ->
let state, _, field = let state, _, field, _ =
IlMachineState.resolveMember loggerFactory baseClassTypes thread activeAssy mr state IlMachineState.resolveMember loggerFactory baseClassTypes thread activeAssy mr state
match field with match field with
@@ -456,10 +535,8 @@ module internal UnaryMetadataIlOp =
let valueToStore, state = IlMachineState.popEvalStack thread state let valueToStore, state = IlMachineState.popEvalStack thread state
let typeGenerics = let state, declaringTypeHandle, typeGenerics =
match field.DeclaringType.Generics with IlMachineState.concretizeFieldForExecution loggerFactory baseClassTypes thread field state
| [] -> None
| l -> Some (ImmutableArray.CreateRange l)
let state, zero = let state, zero =
IlMachineState.cliTypeZeroOf IlMachineState.cliTypeZeroOf
@@ -468,7 +545,7 @@ module internal UnaryMetadataIlOp =
(state.ActiveAssembly thread) (state.ActiveAssembly thread)
field.Signature field.Signature
typeGenerics typeGenerics
None // field can't have its own generics ImmutableArray.Empty // field can't have its own generics
state state
let valueToStore = EvalStackValue.toCliTypeCoerced zero valueToStore let valueToStore = EvalStackValue.toCliTypeCoerced zero valueToStore
@@ -477,7 +554,7 @@ module internal UnaryMetadataIlOp =
if field.Attributes.HasFlag FieldAttributes.Static then if field.Attributes.HasFlag FieldAttributes.Static then
let state = let state =
IlMachineState.setStatic field.DeclaringType field.Name valueToStore state IlMachineState.setStatic declaringTypeHandle field.Name valueToStore state
state, WhatWeDid.Executed state, WhatWeDid.Executed
else else
@@ -534,7 +611,7 @@ module internal UnaryMetadataIlOp =
state, field state, field
| MetadataToken.MemberReference mr -> | MetadataToken.MemberReference mr ->
let state, _, method = let state, _, method, _ =
IlMachineState.resolveMember IlMachineState.resolveMember
loggerFactory loggerFactory
baseClassTypes baseClassTypes
@@ -563,17 +640,15 @@ module internal UnaryMetadataIlOp =
field.Signature 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 | FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| NothingToDo state -> | NothingToDo state ->
let popped, state = IlMachineState.popEvalStack thread state let popped, state = IlMachineState.popEvalStack thread state
let typeGenerics =
match field.DeclaringType.Generics with
| [] -> None
| l -> Some (ImmutableArray.CreateRange l)
let state, zero = let state, zero =
IlMachineState.cliTypeZeroOf IlMachineState.cliTypeZeroOf
loggerFactory loggerFactory
@@ -581,13 +656,13 @@ module internal UnaryMetadataIlOp =
activeAssy activeAssy
field.Signature field.Signature
typeGenerics typeGenerics
None // field can't have its own generics ImmutableArray.Empty // field can't have its own generics
state state
let toStore = EvalStackValue.toCliTypeCoerced zero popped let toStore = EvalStackValue.toCliTypeCoerced zero popped
let state = let state =
IlMachineState.setStatic field.DeclaringType field.Name toStore state IlMachineState.setStatic declaringTypeHandle field.Name toStore state
|> IlMachineState.advanceProgramCounter thread |> IlMachineState.advanceProgramCounter thread
state, WhatWeDid.Executed state, WhatWeDid.Executed
@@ -602,7 +677,7 @@ module internal UnaryMetadataIlOp =
state, field state, field
| MetadataToken.MemberReference mr -> | MetadataToken.MemberReference mr ->
let state, assyName, field = let state, assyName, field, _ =
IlMachineState.resolveMember loggerFactory baseClassTypes thread activeAssy mr state IlMachineState.resolveMember loggerFactory baseClassTypes thread activeAssy mr state
match field with match field with
@@ -624,14 +699,15 @@ module internal UnaryMetadataIlOp =
let currentObj, state = IlMachineState.popEvalStack thread state let currentObj, state = IlMachineState.popEvalStack thread state
let typeGenerics = let state, declaringTypeHandle, typeGenerics =
match field.DeclaringType.Generics with IlMachineState.concretizeFieldForExecution loggerFactory baseClassTypes thread field state
| [] -> None
| l -> Some (ImmutableArray.CreateRange l)
if field.Attributes.HasFlag FieldAttributes.Static then if field.Attributes.HasFlag FieldAttributes.Static then
let declaringTypeHandle, state =
IlMachineState.concretizeFieldDeclaringType loggerFactory baseClassTypes field.DeclaringType state
let state, staticField = let state, staticField =
match IlMachineState.getStatic field.DeclaringType field.Name state with match IlMachineState.getStatic declaringTypeHandle field.Name state with
| Some v -> state, v | Some v -> state, v
| None -> | None ->
let state, zero = let state, zero =
@@ -641,10 +717,10 @@ module internal UnaryMetadataIlOp =
(state.LoadedAssembly(field.DeclaringType.Assembly).Value) (state.LoadedAssembly(field.DeclaringType.Assembly).Value)
field.Signature field.Signature
typeGenerics typeGenerics
None // field can't have its own generics ImmutableArray.Empty // field can't have its own generics
state state
let state = IlMachineState.setStatic field.DeclaringType field.Name zero state let state = IlMachineState.setStatic declaringTypeHandle field.Name zero state
state, zero state, zero
let state = state |> IlMachineState.pushToEvalStack staticField thread let state = state |> IlMachineState.pushToEvalStack staticField thread
@@ -705,7 +781,7 @@ module internal UnaryMetadataIlOp =
state, field state, field
| MetadataToken.MemberReference mr -> | MetadataToken.MemberReference mr ->
let state, _, field = let state, _, field, _ =
IlMachineState.resolveMember loggerFactory baseClassTypes thread activeAssy mr state IlMachineState.resolveMember loggerFactory baseClassTypes thread activeAssy mr state
match field with match field with
@@ -727,17 +803,15 @@ module internal UnaryMetadataIlOp =
field.Signature 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 | FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| NothingToDo state -> | NothingToDo state ->
let typeGenerics =
match field.DeclaringType.Generics with
| [] -> None
| l -> Some (ImmutableArray.CreateRange l)
let fieldValue, state = let fieldValue, state =
match IlMachineState.getStatic field.DeclaringType field.Name state with match IlMachineState.getStatic declaringTypeHandle field.Name state with
| None -> | None ->
let state, newVal = let state, newVal =
IlMachineState.cliTypeZeroOf IlMachineState.cliTypeZeroOf
@@ -746,10 +820,10 @@ module internal UnaryMetadataIlOp =
activeAssy activeAssy
field.Signature field.Signature
typeGenerics typeGenerics
None // field can't have its own generics ImmutableArray.Empty // field can't have its own generics
state state
newVal, IlMachineState.setStatic field.DeclaringType field.Name newVal state newVal, IlMachineState.setStatic declaringTypeHandle field.Name newVal state
| Some v -> v, state | Some v -> v, state
do do
@@ -783,9 +857,7 @@ module internal UnaryMetadataIlOp =
let currentMethod = state.ThreadState.[thread].MethodState.ExecutingMethod let currentMethod = state.ThreadState.[thread].MethodState.ExecutingMethod
let declaringTypeGenerics = let declaringTypeGenerics =
match currentMethod.DeclaringType.Generics with currentMethod.DeclaringType.Generics |> ImmutableArray.CreateRange
| [] -> None
| x -> Some (ImmutableArray.CreateRange x)
let state, assy, elementType = let state, assy, elementType =
match metadataToken with match metadataToken with
@@ -793,9 +865,10 @@ module internal UnaryMetadataIlOp =
state, state,
assy, assy,
assy.TypeDefs.[defn] assy.TypeDefs.[defn]
|> TypeInfo.mapGeneric (fun _ i -> declaringTypeGenerics.Value.[i.SequenceNumber]) |> TypeInfo.mapGeneric (fun _ p -> TypeDefn.GenericTypeParameter p.SequenceNumber)
| MetadataToken.TypeSpecification spec -> | MetadataToken.TypeSpecification spec ->
IlMachineState.resolveTypeFromSpec let state, assy, ty =
IlMachineState.resolveTypeFromSpecConcrete
loggerFactory loggerFactory
baseClassTypes baseClassTypes
spec spec
@@ -803,6 +876,8 @@ module internal UnaryMetadataIlOp =
declaringTypeGenerics declaringTypeGenerics
currentMethod.Generics currentMethod.Generics
state state
state, assy, ty
| x -> failwith $"TODO: Stelem element type resolution unimplemented for {x}" | x -> failwith $"TODO: Stelem element type resolution unimplemented for {x}"
let contents, state = IlMachineState.popEvalStack thread state let contents, state = IlMachineState.popEvalStack thread state
@@ -836,7 +911,7 @@ module internal UnaryMetadataIlOp =
assy assy
elementType elementType
declaringTypeGenerics declaringTypeGenerics
None ImmutableArray.Empty
state state
let contents = EvalStackValue.toCliTypeCoerced zeroOfType contents let contents = EvalStackValue.toCliTypeCoerced zeroOfType contents
@@ -852,9 +927,7 @@ module internal UnaryMetadataIlOp =
let currentMethod = state.ThreadState.[thread].MethodState.ExecutingMethod let currentMethod = state.ThreadState.[thread].MethodState.ExecutingMethod
let declaringTypeGenerics = let declaringTypeGenerics =
match currentMethod.DeclaringType.Generics with currentMethod.DeclaringType.Generics |> ImmutableArray.CreateRange
| [] -> None
| x -> Some (ImmutableArray.CreateRange x)
let state, assy, elementType = let state, assy, elementType =
match metadataToken with match metadataToken with
@@ -862,9 +935,10 @@ module internal UnaryMetadataIlOp =
state, state,
assy, assy,
assy.TypeDefs.[defn] assy.TypeDefs.[defn]
|> TypeInfo.mapGeneric (fun _ i -> declaringTypeGenerics.Value.[i.SequenceNumber]) |> TypeInfo.mapGeneric (fun _ p -> TypeDefn.GenericTypeParameter p.SequenceNumber)
| MetadataToken.TypeSpecification spec -> | MetadataToken.TypeSpecification spec ->
IlMachineState.resolveTypeFromSpec let state, assy, ty =
IlMachineState.resolveTypeFromSpecConcrete
loggerFactory loggerFactory
baseClassTypes baseClassTypes
spec spec
@@ -872,6 +946,8 @@ module internal UnaryMetadataIlOp =
declaringTypeGenerics declaringTypeGenerics
currentMethod.Generics currentMethod.Generics
state state
state, assy, ty
| x -> failwith $"TODO: Ldelem element type resolution unimplemented for {x}" | x -> failwith $"TODO: Ldelem element type resolution unimplemented for {x}"
let index, state = IlMachineState.popEvalStack thread state let index, state = IlMachineState.popEvalStack thread state
@@ -898,7 +974,7 @@ module internal UnaryMetadataIlOp =
else else
failwith "TODO: raise an out of bounds" failwith "TODO: raise an out of bounds"
failwith $"TODO: Ldelem {index} {arr} resulted in {toPush}" IlMachineState.pushToEvalStack toPush thread state
|> IlMachineState.advanceProgramCounter thread |> IlMachineState.advanceProgramCounter thread
|> Tuple.withRight WhatWeDid.Executed |> Tuple.withRight WhatWeDid.Executed
| Initobj -> failwith "TODO: Initobj unimplemented" | Initobj -> failwith "TODO: Initobj unimplemented"
@@ -916,22 +992,20 @@ module internal UnaryMetadataIlOp =
|> FieldInfo.mapTypeGenerics (fun _ _ -> failwith "generics not allowed on FieldDefinition") |> FieldInfo.mapTypeGenerics (fun _ _ -> failwith "generics not allowed on FieldDefinition")
| t -> failwith $"Unexpectedly asked to load a non-field: {t}" | 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 | FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| NothingToDo state -> | NothingToDo state ->
if TypeDefn.isManaged field.Signature then 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 -> | Some v ->
IlMachineState.pushToEvalStack v thread state IlMachineState.pushToEvalStack v thread state
|> IlMachineState.advanceProgramCounter thread |> IlMachineState.advanceProgramCounter thread
|> Tuple.withRight WhatWeDid.Executed |> Tuple.withRight WhatWeDid.Executed
| None -> | None ->
let typeGenerics =
match field.DeclaringType.Generics with
| [] -> None
| l -> Some (ImmutableArray.CreateRange l)
// Field is not yet initialised // Field is not yet initialised
let state, zero = let state, zero =
IlMachineState.cliTypeZeroOf IlMachineState.cliTypeZeroOf
@@ -940,10 +1014,10 @@ module internal UnaryMetadataIlOp =
activeAssy activeAssy
field.Signature field.Signature
typeGenerics typeGenerics
None // field can't have its own generics ImmutableArray.Empty // field can't have its own generics
state state
IlMachineState.setStatic field.DeclaringType field.Name zero state IlMachineState.setStatic declaringTypeHandle field.Name zero state
|> IlMachineState.pushToEvalStack (CliType.ObjectRef None) thread |> IlMachineState.pushToEvalStack (CliType.ObjectRef None) thread
|> IlMachineState.advanceProgramCounter thread |> IlMachineState.advanceProgramCounter thread
|> Tuple.withRight WhatWeDid.Executed |> Tuple.withRight WhatWeDid.Executed
@@ -953,11 +1027,37 @@ module internal UnaryMetadataIlOp =
| Ldftn -> | Ldftn ->
let logger = loggerFactory.CreateLogger "Ldftn" let logger = loggerFactory.CreateLogger "Ldftn"
let method = let (method : MethodInfo<TypeDefn, WoofWare.PawPrint.GenericParameter, TypeDefn>), methodGenerics =
match metadataToken with 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}" | 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 ( logger.LogDebug (
"Pushed pointer to function {LdFtnAssembly}.{LdFtnType}.{LdFtnMethodName}", "Pushed pointer to function {LdFtnAssembly}.{LdFtnType}.{LdFtnMethodName}",
method.DeclaringType.Assembly.Name, method.DeclaringType.Assembly.Name,
@@ -967,7 +1067,7 @@ module internal UnaryMetadataIlOp =
state state
|> IlMachineState.pushToEvalStack' |> IlMachineState.pushToEvalStack'
(EvalStackValue.NativeInt (NativeIntSource.FunctionPointer method)) (EvalStackValue.NativeInt (NativeIntSource.FunctionPointer concretizedMethod))
thread thread
|> IlMachineState.advanceProgramCounter thread |> IlMachineState.advanceProgramCounter thread
|> Tuple.withRight WhatWeDid.Executed |> Tuple.withRight WhatWeDid.Executed
@@ -999,8 +1099,7 @@ module internal UnaryMetadataIlOp =
let currentMethod = state.ThreadState.[thread].MethodState let currentMethod = state.ThreadState.[thread].MethodState
let methodGenerics = let methodGenerics = currentMethod.Generics
currentMethod.Generics |> Option.defaultValue ImmutableArray.Empty
let typeGenerics = currentMethod.ExecutingMethod.DeclaringType.Generics let typeGenerics = currentMethod.ExecutingMethod.DeclaringType.Generics

View File

@@ -52,11 +52,7 @@ module internal UnaryStringTokenIlOp =
] ]
let addr, state = let addr, state =
IlMachineState.allocateManagedObject IlMachineState.allocateManagedObject baseClassTypes.String fields state
(baseClassTypes.String
|> TypeInfo.mapGeneric (fun _ _ -> failwith<unit> "string is not generic"))
fields
state
addr, addr,
{ state with { state with