mirror of
https://github.com/Smaug123/WoofWare.PawPrint
synced 2025-10-06 06:28:39 +00:00
Concrete types - lots of tech debt in here (#79)
This commit is contained in:
74
CLAUDE.md
74
CLAUDE.md
@@ -100,3 +100,77 @@ It strongly prefers to avoid special-casing to get around problems, but instead
|
|||||||
### Common Gotchas
|
### 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
|
||||||
|
@@ -429,50 +429,52 @@ 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
|
||||||
| false, _ -> TypeResolutionResult.FirstLoadAssy assemblyRef
|
| false, _ -> TypeResolutionResult.FirstLoadAssy assemblyRef
|
||||||
| true, assy ->
|
| true, assy ->
|
||||||
|
|
||||||
let nsPath = target.Namespace.Split '.' |> Array.toList
|
let nsPath = target.Namespace.Split '.' |> Array.toList
|
||||||
|
|
||||||
let targetNs = assy.NonRootNamespaces.[nsPath]
|
let targetNs = assy.NonRootNamespaces.[nsPath]
|
||||||
|
|
||||||
let targetType =
|
let targetType =
|
||||||
targetNs.TypeDefinitions
|
targetNs.TypeDefinitions
|
||||||
|> Seq.choose (fun td ->
|
|> Seq.choose (fun td ->
|
||||||
let ty = assy.TypeDefs.[td]
|
let ty = assy.TypeDefs.[td]
|
||||||
|
|
||||||
if ty.Name = target.Name && ty.Namespace = target.Namespace then
|
if ty.Name = target.Name && ty.Namespace = target.Namespace then
|
||||||
Some ty
|
Some ty
|
||||||
else
|
else
|
||||||
None
|
None
|
||||||
)
|
|
||||||
|> Seq.toList
|
|
||||||
|
|
||||||
match targetType with
|
|
||||||
| [ t ] ->
|
|
||||||
let t =
|
|
||||||
t
|
|
||||||
|> TypeInfo.mapGeneric (fun _ param ->
|
|
||||||
match genericArgs with
|
|
||||||
| None -> failwith "got a generic TypeRef but no generic args in context"
|
|
||||||
| Some genericArgs -> genericArgs.[param.SequenceNumber]
|
|
||||||
)
|
)
|
||||||
|
|> Seq.toList
|
||||||
|
|
||||||
TypeResolutionResult.Resolved (assy, t)
|
match targetType with
|
||||||
| _ :: _ :: _ -> failwith $"Multiple matching type definitions! {nsPath} {target.Name}"
|
| [ t ] ->
|
||||||
| [] ->
|
let t = t |> TypeInfo.mapGeneric (fun _ param -> genericArgs.[param.SequenceNumber])
|
||||||
match assy.ExportedType (Some target.Namespace) target.Name with
|
|
||||||
| None -> failwith $"Failed to find type {nsPath} {target.Name} in {assy.Name.FullName}!"
|
TypeResolutionResult.Resolved (assy, t)
|
||||||
| Some ty -> resolveTypeFromExport assy assemblies ty genericArgs
|
| _ :: _ :: _ -> failwith $"Multiple matching type definitions! {nsPath} {target.Name}"
|
||||||
|
| [] ->
|
||||||
|
match assy.ExportedType (Some target.Namespace) target.Name with
|
||||||
|
| None -> failwith $"Failed to find type {nsPath} {target.Name} in {assy.Name.FullName}!"
|
||||||
|
| Some ty -> resolveTypeFromExport assy assemblies ty genericArgs
|
||||||
| k -> failwith $"Unexpected: {k}"
|
| k -> failwith $"Unexpected: {k}"
|
||||||
|
|
||||||
and resolveTypeFromName
|
and resolveTypeFromName
|
||||||
@@ -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"
|
||||||
|
@@ -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
|
||||||
|
900
WoofWare.PawPrint.Domain/TypeConcretisation.fs
Normal file
900
WoofWare.PawPrint.Domain/TypeConcretisation.fs
Normal file
@@ -0,0 +1,900 @@
|
|||||||
|
namespace WoofWare.PawPrint
|
||||||
|
|
||||||
|
open System.Collections.Immutable
|
||||||
|
open System.Reflection
|
||||||
|
open System.Reflection.Metadata
|
||||||
|
|
||||||
|
type ConcreteTypeHandle =
|
||||||
|
| Concrete of int
|
||||||
|
| Byref of ConcreteTypeHandle
|
||||||
|
| Pointer of ConcreteTypeHandle
|
||||||
|
|
||||||
|
type AllConcreteTypes =
|
||||||
|
{
|
||||||
|
Mapping : Map<int, ConcreteType<ConcreteTypeHandle>>
|
||||||
|
NextHandle : int
|
||||||
|
}
|
||||||
|
|
||||||
|
static member Empty =
|
||||||
|
{
|
||||||
|
Mapping = Map.empty
|
||||||
|
NextHandle = 0
|
||||||
|
}
|
||||||
|
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
module AllConcreteTypes =
|
||||||
|
let lookup (cth : ConcreteTypeHandle) (this : AllConcreteTypes) : ConcreteType<ConcreteTypeHandle> option =
|
||||||
|
match cth with
|
||||||
|
| ConcreteTypeHandle.Concrete id -> this.Mapping |> Map.tryFind id
|
||||||
|
| ConcreteTypeHandle.Byref _ -> None // Byref types are not stored in the mapping
|
||||||
|
| ConcreteTypeHandle.Pointer _ -> None // Pointer types are not stored in the mapping
|
||||||
|
|
||||||
|
let lookup' (ct : ConcreteType<ConcreteTypeHandle>) (this : AllConcreteTypes) : ConcreteTypeHandle option =
|
||||||
|
this.Mapping
|
||||||
|
|> Map.tryPick (fun id existingCt ->
|
||||||
|
if
|
||||||
|
existingCt._AssemblyName = ct._AssemblyName
|
||||||
|
&& existingCt._Namespace = ct._Namespace
|
||||||
|
&& existingCt._Name = ct._Name
|
||||||
|
&& existingCt._Definition = ct._Definition
|
||||||
|
&& existingCt._Generics = ct._Generics
|
||||||
|
then
|
||||||
|
Some (ConcreteTypeHandle.Concrete id)
|
||||||
|
else
|
||||||
|
None
|
||||||
|
)
|
||||||
|
|
||||||
|
let findExistingConcreteType
|
||||||
|
(concreteTypes : AllConcreteTypes)
|
||||||
|
(asm : AssemblyName, ns : string, name : string, generics : ConcreteTypeHandle list as key)
|
||||||
|
: ConcreteTypeHandle option
|
||||||
|
=
|
||||||
|
concreteTypes.Mapping
|
||||||
|
|> Map.tryPick (fun id ct ->
|
||||||
|
if
|
||||||
|
ct.Assembly.FullName = asm.FullName
|
||||||
|
&& ct.Namespace = ns
|
||||||
|
&& ct.Name = name
|
||||||
|
&& ct.Generics = generics
|
||||||
|
then
|
||||||
|
Some (ConcreteTypeHandle.Concrete id)
|
||||||
|
else
|
||||||
|
None
|
||||||
|
)
|
||||||
|
|
||||||
|
/// `source` is AssemblyName * Namespace * Name
|
||||||
|
let add (ct : ConcreteType<ConcreteTypeHandle>) (this : AllConcreteTypes) : ConcreteTypeHandle * AllConcreteTypes =
|
||||||
|
let id = this.NextHandle
|
||||||
|
let toRet = ConcreteTypeHandle.Concrete id
|
||||||
|
|
||||||
|
let newState =
|
||||||
|
{
|
||||||
|
NextHandle = this.NextHandle + 1
|
||||||
|
Mapping = this.Mapping |> Map.add id ct
|
||||||
|
}
|
||||||
|
|
||||||
|
toRet, newState
|
||||||
|
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
module TypeConcretization =
|
||||||
|
|
||||||
|
type ConcretizationContext =
|
||||||
|
{
|
||||||
|
/// Types currently being processed (to detect cycles)
|
||||||
|
InProgress : ImmutableDictionary<AssemblyName * TypeDefn, ConcreteTypeHandle>
|
||||||
|
/// All concrete types created so far
|
||||||
|
ConcreteTypes : AllConcreteTypes
|
||||||
|
/// For resolving type references
|
||||||
|
LoadedAssemblies : ImmutableDictionary<string, DumpedAssembly>
|
||||||
|
BaseTypes : BaseClassTypes<DumpedAssembly>
|
||||||
|
}
|
||||||
|
|
||||||
|
// Helper function to find existing types by assembly, namespace, name, and generics
|
||||||
|
let private findExistingType
|
||||||
|
(concreteTypes : AllConcreteTypes)
|
||||||
|
(assembly : AssemblyName)
|
||||||
|
(ns : string)
|
||||||
|
(name : string)
|
||||||
|
(generics : ConcreteTypeHandle list)
|
||||||
|
: ConcreteTypeHandle option
|
||||||
|
=
|
||||||
|
concreteTypes.Mapping
|
||||||
|
|> Map.tryPick (fun id ct ->
|
||||||
|
if
|
||||||
|
ct.Assembly.FullName = assembly.FullName
|
||||||
|
&& ct.Namespace = ns
|
||||||
|
&& ct.Name = name
|
||||||
|
&& ct.Generics = generics
|
||||||
|
then
|
||||||
|
Some (ConcreteTypeHandle.Concrete id)
|
||||||
|
else
|
||||||
|
None
|
||||||
|
)
|
||||||
|
|
||||||
|
// Helper function for primitive types (convenience wrapper)
|
||||||
|
let private findExistingPrimitiveType
|
||||||
|
(concreteTypes : AllConcreteTypes)
|
||||||
|
(key : AssemblyName * string * string)
|
||||||
|
: ConcreteTypeHandle option
|
||||||
|
=
|
||||||
|
let (asm, ns, name) = key
|
||||||
|
findExistingType concreteTypes asm ns name []
|
||||||
|
|
||||||
|
// Helper function to create and add a ConcreteType to the context
|
||||||
|
let private createAndAddConcreteType
|
||||||
|
(ctx : ConcretizationContext)
|
||||||
|
(assembly : AssemblyName)
|
||||||
|
(definition : ComparableTypeDefinitionHandle)
|
||||||
|
(ns : string)
|
||||||
|
(name : string)
|
||||||
|
(generics : ConcreteTypeHandle list)
|
||||||
|
: ConcreteTypeHandle * ConcretizationContext
|
||||||
|
=
|
||||||
|
let concreteType =
|
||||||
|
{
|
||||||
|
_AssemblyName = assembly
|
||||||
|
_Definition = definition
|
||||||
|
_Namespace = ns
|
||||||
|
_Name = name
|
||||||
|
_Generics = generics
|
||||||
|
}
|
||||||
|
|
||||||
|
let handle, newConcreteTypes = AllConcreteTypes.add concreteType ctx.ConcreteTypes
|
||||||
|
|
||||||
|
let newCtx =
|
||||||
|
{ ctx with
|
||||||
|
ConcreteTypes = newConcreteTypes
|
||||||
|
}
|
||||||
|
|
||||||
|
handle, newCtx
|
||||||
|
|
||||||
|
// Helper function for assembly loading with retry pattern
|
||||||
|
let private loadAssemblyAndResolveTypeRef
|
||||||
|
(loadAssembly :
|
||||||
|
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
|
||||||
|
(ctx : ConcretizationContext)
|
||||||
|
(currentAssembly : AssemblyName)
|
||||||
|
(typeRef : TypeRef)
|
||||||
|
: (DumpedAssembly * WoofWare.PawPrint.TypeInfo<_, _>) * ConcretizationContext
|
||||||
|
=
|
||||||
|
let currentAssy =
|
||||||
|
match ctx.LoadedAssemblies.TryGetValue currentAssembly.FullName with
|
||||||
|
| false, _ -> failwithf "Current assembly %s not loaded" currentAssembly.FullName
|
||||||
|
| true, assy -> assy
|
||||||
|
|
||||||
|
// First try to resolve without loading new assemblies
|
||||||
|
let resolutionResult =
|
||||||
|
Assembly.resolveTypeRef ctx.LoadedAssemblies currentAssy typeRef ImmutableArray.Empty
|
||||||
|
|
||||||
|
match resolutionResult with
|
||||||
|
| TypeResolutionResult.Resolved (targetAssy, typeInfo) -> (targetAssy, typeInfo), ctx
|
||||||
|
| TypeResolutionResult.FirstLoadAssy assemblyRef ->
|
||||||
|
// Need to load the assembly
|
||||||
|
match typeRef.ResolutionScope with
|
||||||
|
| TypeRefResolutionScope.Assembly assyRef ->
|
||||||
|
let newAssemblies, loadedAssy = loadAssembly currentAssembly assyRef
|
||||||
|
|
||||||
|
let newCtx =
|
||||||
|
{ ctx with
|
||||||
|
LoadedAssemblies = newAssemblies
|
||||||
|
}
|
||||||
|
|
||||||
|
// Now try to resolve again with the loaded assembly
|
||||||
|
let resolutionResult2 =
|
||||||
|
Assembly.resolveTypeRef newCtx.LoadedAssemblies currentAssy typeRef ImmutableArray.Empty
|
||||||
|
|
||||||
|
match resolutionResult2 with
|
||||||
|
| TypeResolutionResult.Resolved (targetAssy, typeInfo) -> (targetAssy, typeInfo), newCtx
|
||||||
|
| TypeResolutionResult.FirstLoadAssy _ ->
|
||||||
|
failwithf "Failed to resolve type %s.%s after loading assembly" typeRef.Namespace typeRef.Name
|
||||||
|
| _ -> failwith "Unexpected resolution scope"
|
||||||
|
|
||||||
|
let private concretizePrimitive
|
||||||
|
(ctx : ConcretizationContext)
|
||||||
|
(prim : PrimitiveType)
|
||||||
|
: ConcreteTypeHandle * ConcretizationContext
|
||||||
|
=
|
||||||
|
|
||||||
|
// Get the TypeInfo for this primitive from BaseClassTypes
|
||||||
|
let typeInfo =
|
||||||
|
match prim with
|
||||||
|
| PrimitiveType.Boolean -> ctx.BaseTypes.Boolean
|
||||||
|
| PrimitiveType.Char -> ctx.BaseTypes.Char
|
||||||
|
| PrimitiveType.SByte -> ctx.BaseTypes.SByte
|
||||||
|
| PrimitiveType.Byte -> ctx.BaseTypes.Byte
|
||||||
|
| PrimitiveType.Int16 -> ctx.BaseTypes.Int16
|
||||||
|
| PrimitiveType.UInt16 -> ctx.BaseTypes.UInt16
|
||||||
|
| PrimitiveType.Int32 -> ctx.BaseTypes.Int32
|
||||||
|
| PrimitiveType.UInt32 -> ctx.BaseTypes.UInt32
|
||||||
|
| PrimitiveType.Int64 -> ctx.BaseTypes.Int64
|
||||||
|
| PrimitiveType.UInt64 -> ctx.BaseTypes.UInt64
|
||||||
|
| PrimitiveType.Single -> ctx.BaseTypes.Single
|
||||||
|
| PrimitiveType.Double -> ctx.BaseTypes.Double
|
||||||
|
| PrimitiveType.String -> ctx.BaseTypes.String
|
||||||
|
| PrimitiveType.Object -> ctx.BaseTypes.Object
|
||||||
|
| PrimitiveType.TypedReference -> ctx.BaseTypes.TypedReference
|
||||||
|
| PrimitiveType.IntPtr -> ctx.BaseTypes.IntPtr
|
||||||
|
| PrimitiveType.UIntPtr -> ctx.BaseTypes.UIntPtr
|
||||||
|
|
||||||
|
// Check if we've already concretized this primitive type
|
||||||
|
let key = (typeInfo.Assembly, typeInfo.Namespace, typeInfo.Name)
|
||||||
|
|
||||||
|
match findExistingPrimitiveType ctx.ConcreteTypes key with
|
||||||
|
| Some handle -> handle, ctx
|
||||||
|
| None ->
|
||||||
|
// Create and add the concrete type (primitives have no generic arguments)
|
||||||
|
createAndAddConcreteType
|
||||||
|
ctx
|
||||||
|
typeInfo.Assembly
|
||||||
|
(ComparableTypeDefinitionHandle.Make typeInfo.TypeDefHandle)
|
||||||
|
typeInfo.Namespace
|
||||||
|
typeInfo.Name
|
||||||
|
[] // Primitives have no generic parameters
|
||||||
|
|
||||||
|
let private concretizeArray
|
||||||
|
(ctx : ConcretizationContext)
|
||||||
|
(elementHandle : ConcreteTypeHandle)
|
||||||
|
(shape : 'a)
|
||||||
|
: ConcreteTypeHandle * ConcretizationContext
|
||||||
|
=
|
||||||
|
|
||||||
|
// Arrays are System.Array<T> where T is the element type
|
||||||
|
let arrayTypeInfo = ctx.BaseTypes.Array
|
||||||
|
|
||||||
|
// Check if we've already concretized this array type
|
||||||
|
match
|
||||||
|
findExistingType
|
||||||
|
ctx.ConcreteTypes
|
||||||
|
arrayTypeInfo.Assembly
|
||||||
|
arrayTypeInfo.Namespace
|
||||||
|
arrayTypeInfo.Name
|
||||||
|
[ elementHandle ]
|
||||||
|
with
|
||||||
|
| Some handle -> handle, ctx
|
||||||
|
| None ->
|
||||||
|
// Create and add the concrete array type
|
||||||
|
createAndAddConcreteType
|
||||||
|
ctx
|
||||||
|
arrayTypeInfo.Assembly
|
||||||
|
(ComparableTypeDefinitionHandle.Make arrayTypeInfo.TypeDefHandle)
|
||||||
|
arrayTypeInfo.Namespace
|
||||||
|
arrayTypeInfo.Name
|
||||||
|
[ elementHandle ] // Array<T> has one generic parameter
|
||||||
|
|
||||||
|
let private concretizeOneDimArray
|
||||||
|
(ctx : ConcretizationContext)
|
||||||
|
(elementHandle : ConcreteTypeHandle)
|
||||||
|
: ConcreteTypeHandle * ConcretizationContext
|
||||||
|
=
|
||||||
|
|
||||||
|
// One-dimensional arrays with lower bound 0 are also System.Array<T>
|
||||||
|
// They just have different IL instructions for access
|
||||||
|
let arrayTypeInfo = ctx.BaseTypes.Array
|
||||||
|
|
||||||
|
// Check if we've already concretized this array type
|
||||||
|
match
|
||||||
|
findExistingType
|
||||||
|
ctx.ConcreteTypes
|
||||||
|
arrayTypeInfo.Assembly
|
||||||
|
arrayTypeInfo.Namespace
|
||||||
|
arrayTypeInfo.Name
|
||||||
|
[ elementHandle ]
|
||||||
|
with
|
||||||
|
| Some handle -> handle, ctx
|
||||||
|
| None ->
|
||||||
|
// Create and add the concrete array type
|
||||||
|
createAndAddConcreteType
|
||||||
|
ctx
|
||||||
|
arrayTypeInfo.Assembly
|
||||||
|
(ComparableTypeDefinitionHandle.Make arrayTypeInfo.TypeDefHandle)
|
||||||
|
arrayTypeInfo.Namespace
|
||||||
|
arrayTypeInfo.Name
|
||||||
|
[ elementHandle ] // Array<T> has one generic parameter
|
||||||
|
|
||||||
|
let concretizeTypeDefinition
|
||||||
|
(ctx : ConcretizationContext)
|
||||||
|
(assemblyName : AssemblyName)
|
||||||
|
(typeDefHandle : ComparableTypeDefinitionHandle)
|
||||||
|
: ConcreteTypeHandle * ConcretizationContext
|
||||||
|
=
|
||||||
|
|
||||||
|
// Look up the type definition in the assembly
|
||||||
|
let assembly =
|
||||||
|
match ctx.LoadedAssemblies.TryGetValue assemblyName.FullName with
|
||||||
|
| false, _ -> failwithf "Cannot concretize type definition - assembly %s not loaded" assemblyName.FullName
|
||||||
|
| true, assy -> assy
|
||||||
|
|
||||||
|
let typeInfo = assembly.TypeDefs.[typeDefHandle.Get]
|
||||||
|
|
||||||
|
// Check if this type has generic parameters
|
||||||
|
if not typeInfo.Generics.IsEmpty then
|
||||||
|
failwithf
|
||||||
|
"Cannot concretize open generic type %s.%s - it has %d generic parameters"
|
||||||
|
typeInfo.Namespace
|
||||||
|
typeInfo.Name
|
||||||
|
typeInfo.Generics.Length
|
||||||
|
|
||||||
|
// Check if we've already concretized this type
|
||||||
|
match findExistingType ctx.ConcreteTypes assemblyName typeInfo.Namespace typeInfo.Name [] with
|
||||||
|
| Some handle -> handle, ctx
|
||||||
|
| None ->
|
||||||
|
// Create and add the concrete type (no generic arguments since it's not generic)
|
||||||
|
createAndAddConcreteType ctx assemblyName typeDefHandle typeInfo.Namespace typeInfo.Name [] // No generic parameters
|
||||||
|
|
||||||
|
let private concretizeTypeReference
|
||||||
|
(loadAssembly :
|
||||||
|
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
|
||||||
|
(ctx : ConcretizationContext)
|
||||||
|
(currentAssembly : AssemblyName)
|
||||||
|
(typeRef : TypeRef)
|
||||||
|
: ConcreteTypeHandle * ConcretizationContext
|
||||||
|
=
|
||||||
|
// Use the helper to load assembly and resolve the type reference
|
||||||
|
let (targetAssy, typeInfo), ctx =
|
||||||
|
loadAssemblyAndResolveTypeRef loadAssembly ctx currentAssembly typeRef
|
||||||
|
|
||||||
|
// Check if this type has generic parameters
|
||||||
|
if not typeInfo.Generics.IsEmpty then
|
||||||
|
failwithf
|
||||||
|
"Cannot concretize type reference to open generic type %s.%s - it has %d generic parameters"
|
||||||
|
typeInfo.Namespace
|
||||||
|
typeInfo.Name
|
||||||
|
typeInfo.Generics.Length
|
||||||
|
|
||||||
|
// Create or find the concrete type
|
||||||
|
concretizeTypeDefinition ctx targetAssy.Name (ComparableTypeDefinitionHandle.Make typeInfo.TypeDefHandle)
|
||||||
|
|
||||||
|
/// Concretize a type in a specific generic context
|
||||||
|
let rec concretizeType
|
||||||
|
(ctx : ConcretizationContext)
|
||||||
|
(loadAssembly :
|
||||||
|
AssemblyName -> AssemblyReferenceHandle -> (ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly))
|
||||||
|
(assembly : AssemblyName)
|
||||||
|
(typeGenerics : ConcreteTypeHandle ImmutableArray)
|
||||||
|
(methodGenerics : ConcreteTypeHandle ImmutableArray)
|
||||||
|
(typeDefn : TypeDefn)
|
||||||
|
: ConcreteTypeHandle * ConcretizationContext
|
||||||
|
=
|
||||||
|
|
||||||
|
let key = (assembly, typeDefn)
|
||||||
|
|
||||||
|
// Check if we're already processing this type (cycle detection)
|
||||||
|
match ctx.InProgress.TryGetValue key with
|
||||||
|
| true, handle -> handle, ctx
|
||||||
|
| false, _ ->
|
||||||
|
|
||||||
|
match typeDefn with
|
||||||
|
| TypeDefn.PrimitiveType prim -> concretizePrimitive ctx prim
|
||||||
|
|
||||||
|
| TypeDefn.Array (elementType, shape) ->
|
||||||
|
let elementHandle, ctx =
|
||||||
|
concretizeType ctx loadAssembly assembly typeGenerics methodGenerics elementType
|
||||||
|
|
||||||
|
concretizeArray ctx elementHandle shape
|
||||||
|
|
||||||
|
| TypeDefn.OneDimensionalArrayLowerBoundZero elementType ->
|
||||||
|
let elementHandle, ctx =
|
||||||
|
concretizeType ctx loadAssembly assembly typeGenerics methodGenerics elementType
|
||||||
|
|
||||||
|
concretizeOneDimArray ctx elementHandle
|
||||||
|
|
||||||
|
| TypeDefn.GenericTypeParameter index ->
|
||||||
|
if index < typeGenerics.Length then
|
||||||
|
typeGenerics.[index], ctx
|
||||||
|
else
|
||||||
|
failwithf "Generic type parameter %d out of range" index
|
||||||
|
|
||||||
|
| TypeDefn.GenericMethodParameter index ->
|
||||||
|
if index < methodGenerics.Length then
|
||||||
|
methodGenerics.[index], ctx
|
||||||
|
else
|
||||||
|
failwithf "Generic method parameter %d out of range" index
|
||||||
|
|
||||||
|
| TypeDefn.GenericInstantiation (genericDef, args) ->
|
||||||
|
concretizeGenericInstantiation ctx loadAssembly assembly typeGenerics methodGenerics genericDef args
|
||||||
|
|
||||||
|
| TypeDefn.FromDefinition (typeDefHandle, targetAssembly, _) ->
|
||||||
|
concretizeTypeDefinition ctx (AssemblyName targetAssembly) typeDefHandle
|
||||||
|
|
||||||
|
| TypeDefn.FromReference (typeRef, _) -> concretizeTypeReference loadAssembly ctx assembly typeRef
|
||||||
|
|
||||||
|
| TypeDefn.Byref elementType ->
|
||||||
|
// Byref types are managed references to other types
|
||||||
|
// First concretize the element type
|
||||||
|
let elementHandle, ctx =
|
||||||
|
concretizeType ctx loadAssembly assembly typeGenerics methodGenerics elementType
|
||||||
|
|
||||||
|
// Return a Byref constructor wrapping the element type
|
||||||
|
ConcreteTypeHandle.Byref elementHandle, ctx
|
||||||
|
|
||||||
|
| TypeDefn.Pointer elementType ->
|
||||||
|
// Pointer types are unmanaged pointers to other types
|
||||||
|
// First concretize the element type
|
||||||
|
let elementHandle, ctx =
|
||||||
|
concretizeType ctx loadAssembly assembly typeGenerics methodGenerics elementType
|
||||||
|
|
||||||
|
// Return a Pointer constructor wrapping the element type
|
||||||
|
ConcreteTypeHandle.Pointer elementHandle, ctx
|
||||||
|
|
||||||
|
| TypeDefn.Void ->
|
||||||
|
// Void isn't a real runtime type, but we assign it a concretization entry anyway
|
||||||
|
// Use System.Void from the base class types
|
||||||
|
let voidTypeInfo = ctx.BaseTypes.Void
|
||||||
|
|
||||||
|
match
|
||||||
|
findExistingType ctx.ConcreteTypes voidTypeInfo.Assembly voidTypeInfo.Namespace voidTypeInfo.Name []
|
||||||
|
with
|
||||||
|
| Some handle -> handle, ctx
|
||||||
|
| None ->
|
||||||
|
// Create and add the concrete Void type
|
||||||
|
createAndAddConcreteType
|
||||||
|
ctx
|
||||||
|
voidTypeInfo.Assembly
|
||||||
|
(ComparableTypeDefinitionHandle.Make voidTypeInfo.TypeDefHandle)
|
||||||
|
voidTypeInfo.Namespace
|
||||||
|
voidTypeInfo.Name
|
||||||
|
[] // Void has no generic parameters
|
||||||
|
|
||||||
|
| _ -> failwithf "TODO: Concretization of %A not implemented" typeDefn
|
||||||
|
|
||||||
|
and private concretizeGenericInstantiation
|
||||||
|
(ctx : ConcretizationContext)
|
||||||
|
(loadAssembly :
|
||||||
|
AssemblyName -> AssemblyReferenceHandle -> (ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly))
|
||||||
|
(assembly : AssemblyName)
|
||||||
|
(typeGenerics : ConcreteTypeHandle ImmutableArray)
|
||||||
|
(methodGenerics : ConcreteTypeHandle ImmutableArray)
|
||||||
|
(genericDef : TypeDefn)
|
||||||
|
(args : ImmutableArray<TypeDefn>)
|
||||||
|
: ConcreteTypeHandle * ConcretizationContext
|
||||||
|
=
|
||||||
|
// First, concretize all type arguments
|
||||||
|
let argHandles, ctxAfterArgs =
|
||||||
|
args
|
||||||
|
|> Seq.fold
|
||||||
|
(fun (handles, ctx) arg ->
|
||||||
|
let handle, ctx =
|
||||||
|
concretizeType ctx loadAssembly assembly typeGenerics methodGenerics arg
|
||||||
|
|
||||||
|
handle :: handles, ctx
|
||||||
|
)
|
||||||
|
([], ctx)
|
||||||
|
|
||||||
|
let argHandles = argHandles |> List.rev
|
||||||
|
|
||||||
|
// Get the base type definition
|
||||||
|
let baseAssembly, baseTypeDefHandle, baseNamespace, baseName, ctxAfterArgs =
|
||||||
|
match genericDef with
|
||||||
|
| FromDefinition (handle, assy, _) ->
|
||||||
|
// Look up the type definition to get namespace and name
|
||||||
|
let currentAssy = ctxAfterArgs.LoadedAssemblies.[AssemblyName(assy).FullName]
|
||||||
|
let typeDef = currentAssy.TypeDefs.[handle.Get]
|
||||||
|
AssemblyName assy, handle, typeDef.Namespace, typeDef.Name, ctxAfterArgs
|
||||||
|
| FromReference (typeRef, _) ->
|
||||||
|
// For a type reference, we need to find where the type is defined
|
||||||
|
// We're looking for the generic type definition, not an instantiation
|
||||||
|
let currentAssy = ctxAfterArgs.LoadedAssemblies.[assembly.FullName]
|
||||||
|
|
||||||
|
// Helper to find the type definition without instantiating generics
|
||||||
|
let rec findTypeDefinition (assy : DumpedAssembly) (ns : string) (name : string) =
|
||||||
|
// First check if it's defined in this assembly
|
||||||
|
match assy.TypeDef ns name with
|
||||||
|
| Some typeDef -> Some (assy, typeDef)
|
||||||
|
| None ->
|
||||||
|
// Check if it's exported/forwarded
|
||||||
|
match assy.ExportedType (Some ns) name with
|
||||||
|
| Some export ->
|
||||||
|
match export.Data with
|
||||||
|
| NonForwarded _ -> None // Shouldn't happen
|
||||||
|
| ForwardsTo assyRef ->
|
||||||
|
let forwardedAssy = assy.AssemblyReferences.[assyRef]
|
||||||
|
|
||||||
|
match ctxAfterArgs.LoadedAssemblies.TryGetValue forwardedAssy.Name.FullName with
|
||||||
|
| true, targetAssy -> findTypeDefinition targetAssy ns name
|
||||||
|
| false, _ -> None // Assembly not loaded yet
|
||||||
|
| None -> None
|
||||||
|
|
||||||
|
// First try to resolve without loading new assemblies
|
||||||
|
match typeRef.ResolutionScope with
|
||||||
|
| TypeRefResolutionScope.Assembly assyRef ->
|
||||||
|
let targetAssyRef = currentAssy.AssemblyReferences.[assyRef]
|
||||||
|
let targetAssyName = targetAssyRef.Name
|
||||||
|
|
||||||
|
match ctxAfterArgs.LoadedAssemblies.TryGetValue targetAssyName.FullName with
|
||||||
|
| true, targetAssy ->
|
||||||
|
// Try to find the type
|
||||||
|
match findTypeDefinition targetAssy typeRef.Namespace typeRef.Name with
|
||||||
|
| Some (foundAssy, typeDef) ->
|
||||||
|
foundAssy.Name,
|
||||||
|
ComparableTypeDefinitionHandle.Make typeDef.TypeDefHandle,
|
||||||
|
typeDef.Namespace,
|
||||||
|
typeDef.Name,
|
||||||
|
ctxAfterArgs
|
||||||
|
| None ->
|
||||||
|
failwithf
|
||||||
|
"Type %s.%s not found in assembly %s or its forwards"
|
||||||
|
typeRef.Namespace
|
||||||
|
typeRef.Name
|
||||||
|
targetAssyName.FullName
|
||||||
|
|
||||||
|
| false, _ ->
|
||||||
|
// Need to load the assembly
|
||||||
|
let newAssemblies, loadedAssy = loadAssembly assembly assyRef
|
||||||
|
|
||||||
|
let ctxWithNewAssy =
|
||||||
|
{ ctxAfterArgs with
|
||||||
|
LoadedAssemblies = newAssemblies
|
||||||
|
}
|
||||||
|
|
||||||
|
// Now try to find the type in the loaded assembly
|
||||||
|
match findTypeDefinition loadedAssy typeRef.Namespace typeRef.Name with
|
||||||
|
| Some (foundAssy, typeDef) ->
|
||||||
|
foundAssy.Name,
|
||||||
|
ComparableTypeDefinitionHandle.Make typeDef.TypeDefHandle,
|
||||||
|
typeDef.Namespace,
|
||||||
|
typeDef.Name,
|
||||||
|
ctxWithNewAssy
|
||||||
|
| None ->
|
||||||
|
failwithf
|
||||||
|
"Type %s.%s not found in loaded assembly %s or its forwards"
|
||||||
|
typeRef.Namespace
|
||||||
|
typeRef.Name
|
||||||
|
loadedAssy.Name.FullName
|
||||||
|
|
||||||
|
| _ -> failwith "TODO: handle other resolution scopes for type refs in generic instantiation"
|
||||||
|
| _ -> failwithf "Generic instantiation of %A not supported" genericDef
|
||||||
|
|
||||||
|
// Check if this exact generic instantiation already exists
|
||||||
|
match findExistingType ctxAfterArgs.ConcreteTypes baseAssembly baseNamespace baseName argHandles with
|
||||||
|
| Some existingHandle ->
|
||||||
|
// Type already exists, return it
|
||||||
|
existingHandle, ctxAfterArgs
|
||||||
|
| None ->
|
||||||
|
// Need to handle cycles: check if we're already processing this type
|
||||||
|
let typeDefnKey = (assembly, GenericInstantiation (genericDef, args))
|
||||||
|
|
||||||
|
match ctxAfterArgs.InProgress.TryGetValue typeDefnKey with
|
||||||
|
| true, handle ->
|
||||||
|
// We're in a cycle, return the in-progress handle
|
||||||
|
handle, ctxAfterArgs
|
||||||
|
| false, _ ->
|
||||||
|
// Pre-allocate a handle for this type to handle cycles
|
||||||
|
let tempId = ctxAfterArgs.ConcreteTypes.NextHandle
|
||||||
|
let tempHandle = ConcreteTypeHandle.Concrete tempId
|
||||||
|
|
||||||
|
// Create the concrete type
|
||||||
|
let concreteType =
|
||||||
|
{
|
||||||
|
_AssemblyName = baseAssembly
|
||||||
|
_Definition = baseTypeDefHandle
|
||||||
|
_Namespace = baseNamespace
|
||||||
|
_Name = baseName
|
||||||
|
_Generics = argHandles
|
||||||
|
}
|
||||||
|
|
||||||
|
// Add to the concrete types and mark as in progress
|
||||||
|
let newCtx =
|
||||||
|
{ ctxAfterArgs with
|
||||||
|
ConcreteTypes =
|
||||||
|
{ ctxAfterArgs.ConcreteTypes with
|
||||||
|
NextHandle = ctxAfterArgs.ConcreteTypes.NextHandle + 1
|
||||||
|
Mapping = ctxAfterArgs.ConcreteTypes.Mapping |> Map.add tempId concreteType
|
||||||
|
}
|
||||||
|
InProgress = ctxAfterArgs.InProgress.SetItem (typeDefnKey, tempHandle)
|
||||||
|
}
|
||||||
|
|
||||||
|
// Remove from in-progress when done
|
||||||
|
let finalCtx =
|
||||||
|
{ newCtx with
|
||||||
|
InProgress = newCtx.InProgress.Remove typeDefnKey
|
||||||
|
}
|
||||||
|
|
||||||
|
tempHandle, finalCtx
|
||||||
|
|
||||||
|
/// High-level API for concretizing types
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
module Concretization =
|
||||||
|
|
||||||
|
/// Helper to concretize an array of types
|
||||||
|
let private concretizeTypeArray
|
||||||
|
(ctx : TypeConcretization.ConcretizationContext)
|
||||||
|
(loadAssembly :
|
||||||
|
AssemblyName -> AssemblyReferenceHandle -> (ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly))
|
||||||
|
(assembly : AssemblyName)
|
||||||
|
(typeArgs : ConcreteTypeHandle ImmutableArray)
|
||||||
|
(methodArgs : ConcreteTypeHandle ImmutableArray)
|
||||||
|
(types : ImmutableArray<TypeDefn>)
|
||||||
|
: ImmutableArray<ConcreteTypeHandle> * TypeConcretization.ConcretizationContext
|
||||||
|
=
|
||||||
|
|
||||||
|
let handles = ImmutableArray.CreateBuilder (types.Length)
|
||||||
|
let mutable ctx = ctx
|
||||||
|
|
||||||
|
for i = 0 to types.Length - 1 do
|
||||||
|
let handle, newCtx =
|
||||||
|
TypeConcretization.concretizeType ctx loadAssembly assembly typeArgs methodArgs types.[i]
|
||||||
|
|
||||||
|
handles.Add handle
|
||||||
|
ctx <- newCtx
|
||||||
|
|
||||||
|
handles.ToImmutable (), ctx
|
||||||
|
|
||||||
|
/// Helper to concretize a method signature
|
||||||
|
let private concretizeMethodSignature
|
||||||
|
(ctx : TypeConcretization.ConcretizationContext)
|
||||||
|
(loadAssembly :
|
||||||
|
AssemblyName -> AssemblyReferenceHandle -> (ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly))
|
||||||
|
(assembly : AssemblyName)
|
||||||
|
(typeArgs : ConcreteTypeHandle ImmutableArray)
|
||||||
|
(methodArgs : ConcreteTypeHandle ImmutableArray)
|
||||||
|
(signature : TypeMethodSignature<TypeDefn>)
|
||||||
|
: TypeMethodSignature<ConcreteTypeHandle> * TypeConcretization.ConcretizationContext
|
||||||
|
=
|
||||||
|
|
||||||
|
// Concretize return type
|
||||||
|
let returnHandle, ctx =
|
||||||
|
TypeConcretization.concretizeType ctx loadAssembly assembly typeArgs methodArgs signature.ReturnType
|
||||||
|
|
||||||
|
// Concretize parameter types
|
||||||
|
let paramHandles = ResizeArray<ConcreteTypeHandle> ()
|
||||||
|
let mutable ctx = ctx
|
||||||
|
|
||||||
|
for paramType in signature.ParameterTypes do
|
||||||
|
let handle, newCtx =
|
||||||
|
TypeConcretization.concretizeType ctx loadAssembly assembly typeArgs methodArgs paramType
|
||||||
|
|
||||||
|
paramHandles.Add (handle)
|
||||||
|
ctx <- newCtx
|
||||||
|
|
||||||
|
let newSignature =
|
||||||
|
{
|
||||||
|
Header = signature.Header
|
||||||
|
ReturnType = returnHandle
|
||||||
|
ParameterTypes = paramHandles |> Seq.toList
|
||||||
|
GenericParameterCount = signature.GenericParameterCount
|
||||||
|
RequiredParameterCount = signature.RequiredParameterCount
|
||||||
|
}
|
||||||
|
|
||||||
|
newSignature, ctx
|
||||||
|
|
||||||
|
/// Helper to ensure base type assembly is loaded
|
||||||
|
let rec private ensureBaseTypeAssembliesLoaded
|
||||||
|
(loadAssembly :
|
||||||
|
AssemblyName -> AssemblyReferenceHandle -> (ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly))
|
||||||
|
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||||
|
(assyName : AssemblyName)
|
||||||
|
(baseTypeInfo : BaseTypeInfo option)
|
||||||
|
: ImmutableDictionary<string, DumpedAssembly>
|
||||||
|
=
|
||||||
|
match baseTypeInfo with
|
||||||
|
| None -> assemblies
|
||||||
|
| Some (BaseTypeInfo.TypeRef r) ->
|
||||||
|
let assy = assemblies.[assyName.FullName]
|
||||||
|
let typeRef = assy.TypeRefs.[r]
|
||||||
|
|
||||||
|
match typeRef.ResolutionScope with
|
||||||
|
| TypeRefResolutionScope.Assembly assyRef ->
|
||||||
|
let targetAssyRef = assy.AssemblyReferences.[assyRef]
|
||||||
|
|
||||||
|
match assemblies.TryGetValue targetAssyRef.Name.FullName with
|
||||||
|
| true, _ -> assemblies
|
||||||
|
| false, _ ->
|
||||||
|
// Need to load the assembly - pass the assembly that contains the reference
|
||||||
|
let newAssemblies, _ = loadAssembly assy.Name assyRef
|
||||||
|
newAssemblies
|
||||||
|
| _ -> assemblies
|
||||||
|
| Some (BaseTypeInfo.TypeDef _)
|
||||||
|
| Some (BaseTypeInfo.ForeignAssemblyType _)
|
||||||
|
| Some (BaseTypeInfo.TypeSpec _) -> assemblies
|
||||||
|
|
||||||
|
/// Concretize a method's signature and body
|
||||||
|
let concretizeMethod
|
||||||
|
(ctx : AllConcreteTypes)
|
||||||
|
(loadAssembly :
|
||||||
|
AssemblyName -> AssemblyReferenceHandle -> (ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly))
|
||||||
|
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||||
|
(baseTypes : BaseClassTypes<DumpedAssembly>)
|
||||||
|
(method : WoofWare.PawPrint.MethodInfo<TypeDefn, WoofWare.PawPrint.GenericParameter, TypeDefn>)
|
||||||
|
(typeArgs : ConcreteTypeHandle ImmutableArray)
|
||||||
|
(methodArgs : ConcreteTypeHandle ImmutableArray)
|
||||||
|
: WoofWare.PawPrint.MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle> *
|
||||||
|
AllConcreteTypes *
|
||||||
|
ImmutableDictionary<string, DumpedAssembly>
|
||||||
|
=
|
||||||
|
|
||||||
|
// Ensure base type assemblies are loaded for the declaring type
|
||||||
|
let assemblies =
|
||||||
|
let assy = assemblies.[method.DeclaringType._AssemblyName.FullName]
|
||||||
|
let typeDef = assy.TypeDefs.[method.DeclaringType._Definition.Get]
|
||||||
|
ensureBaseTypeAssembliesLoaded loadAssembly assemblies assy.Name typeDef.BaseType
|
||||||
|
|
||||||
|
let concCtx =
|
||||||
|
{
|
||||||
|
TypeConcretization.ConcretizationContext.InProgress = ImmutableDictionary.Empty
|
||||||
|
TypeConcretization.ConcretizationContext.ConcreteTypes = ctx
|
||||||
|
TypeConcretization.ConcretizationContext.LoadedAssemblies = assemblies
|
||||||
|
TypeConcretization.ConcretizationContext.BaseTypes = baseTypes
|
||||||
|
}
|
||||||
|
|
||||||
|
// First, we need to create a TypeDefn for the declaring type with its generics instantiated
|
||||||
|
let declaringTypeDefn =
|
||||||
|
if method.DeclaringType._Generics.IsEmpty then
|
||||||
|
// Non-generic type - determine the SignatureTypeKind
|
||||||
|
let assy = concCtx.LoadedAssemblies.[method.DeclaringType._AssemblyName.FullName]
|
||||||
|
let arg = assy.TypeDefs.[method.DeclaringType._Definition.Get]
|
||||||
|
|
||||||
|
let baseType =
|
||||||
|
arg.BaseType
|
||||||
|
|> DumpedAssembly.resolveBaseType baseTypes concCtx.LoadedAssemblies assy.Name
|
||||||
|
|
||||||
|
let signatureTypeKind =
|
||||||
|
match baseType with
|
||||||
|
| ResolvedBaseType.Enum
|
||||||
|
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
|
||||||
|
| ResolvedBaseType.Object
|
||||||
|
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
|
||||||
|
|
||||||
|
TypeDefn.FromDefinition (
|
||||||
|
method.DeclaringType._Definition,
|
||||||
|
method.DeclaringType._AssemblyName.FullName,
|
||||||
|
signatureTypeKind
|
||||||
|
)
|
||||||
|
else
|
||||||
|
// Generic type - create a GenericInstantiation
|
||||||
|
let assy = concCtx.LoadedAssemblies.[method.DeclaringType._AssemblyName.FullName]
|
||||||
|
let arg = assy.TypeDefs.[method.DeclaringType._Definition.Get]
|
||||||
|
|
||||||
|
let baseTypeResolved =
|
||||||
|
arg.BaseType
|
||||||
|
|> DumpedAssembly.resolveBaseType baseTypes concCtx.LoadedAssemblies assy.Name
|
||||||
|
|
||||||
|
let signatureTypeKind =
|
||||||
|
match baseTypeResolved with
|
||||||
|
| ResolvedBaseType.Enum
|
||||||
|
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
|
||||||
|
| ResolvedBaseType.Object
|
||||||
|
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
|
||||||
|
|
||||||
|
let baseType =
|
||||||
|
TypeDefn.FromDefinition (
|
||||||
|
method.DeclaringType._Definition,
|
||||||
|
method.DeclaringType._AssemblyName.FullName,
|
||||||
|
signatureTypeKind
|
||||||
|
)
|
||||||
|
|
||||||
|
let genericArgsLength = method.DeclaringType.Generics.Length
|
||||||
|
|
||||||
|
if genericArgsLength > typeArgs.Length then
|
||||||
|
failwithf
|
||||||
|
"Method declaring type expects %d generic arguments but only %d provided"
|
||||||
|
genericArgsLength
|
||||||
|
typeArgs.Length
|
||||||
|
|
||||||
|
let genericArgs =
|
||||||
|
typeArgs.Slice (0, genericArgsLength)
|
||||||
|
|> Seq.mapi (fun i _ -> TypeDefn.GenericTypeParameter i)
|
||||||
|
|> ImmutableArray.CreateRange
|
||||||
|
|
||||||
|
TypeDefn.GenericInstantiation (baseType, genericArgs)
|
||||||
|
|
||||||
|
// Concretize the declaring type
|
||||||
|
let declaringHandle, concCtx =
|
||||||
|
TypeConcretization.concretizeType
|
||||||
|
concCtx
|
||||||
|
loadAssembly
|
||||||
|
method.DeclaringType._AssemblyName
|
||||||
|
typeArgs
|
||||||
|
methodArgs
|
||||||
|
declaringTypeDefn
|
||||||
|
|
||||||
|
// Look up the concretized declaring type
|
||||||
|
let concretizedDeclaringType =
|
||||||
|
AllConcreteTypes.lookup declaringHandle concCtx.ConcreteTypes |> Option.get
|
||||||
|
|
||||||
|
// Concretize signature
|
||||||
|
let signature, concCtx =
|
||||||
|
concretizeMethodSignature
|
||||||
|
concCtx
|
||||||
|
loadAssembly
|
||||||
|
method.DeclaringType._AssemblyName
|
||||||
|
typeArgs
|
||||||
|
methodArgs
|
||||||
|
method.Signature
|
||||||
|
|
||||||
|
// Concretize local variables
|
||||||
|
let instructions, concCtx2 =
|
||||||
|
match method.Instructions with
|
||||||
|
| None -> None, concCtx
|
||||||
|
| Some instr ->
|
||||||
|
let locals, updatedCtx =
|
||||||
|
match instr.LocalVars with
|
||||||
|
| None -> None, concCtx
|
||||||
|
| Some vars ->
|
||||||
|
let handles, ctx =
|
||||||
|
concretizeTypeArray
|
||||||
|
concCtx
|
||||||
|
loadAssembly
|
||||||
|
method.DeclaringType._AssemblyName
|
||||||
|
typeArgs
|
||||||
|
methodArgs
|
||||||
|
vars
|
||||||
|
|
||||||
|
Some handles, ctx
|
||||||
|
|
||||||
|
Some (MethodInstructions.setLocalVars locals instr), updatedCtx
|
||||||
|
|
||||||
|
// Map generics to handles
|
||||||
|
let genericHandles =
|
||||||
|
method.Generics
|
||||||
|
|> Seq.mapi (fun i _ -> methodArgs.[i])
|
||||||
|
|> ImmutableArray.CreateRange
|
||||||
|
|
||||||
|
let concretizedMethod : MethodInfo<_, _, ConcreteTypeHandle> =
|
||||||
|
{
|
||||||
|
DeclaringType = concretizedDeclaringType
|
||||||
|
Handle = method.Handle
|
||||||
|
Name = method.Name
|
||||||
|
Instructions = instructions
|
||||||
|
Parameters = method.Parameters
|
||||||
|
Generics = genericHandles
|
||||||
|
Signature = signature
|
||||||
|
RawSignature = method.RawSignature
|
||||||
|
CustomAttributes = method.CustomAttributes
|
||||||
|
MethodAttributes = method.MethodAttributes
|
||||||
|
ImplAttributes = method.ImplAttributes
|
||||||
|
IsStatic = method.IsStatic
|
||||||
|
}
|
||||||
|
|
||||||
|
concretizedMethod, concCtx2.ConcreteTypes, concCtx2.LoadedAssemblies
|
||||||
|
|
||||||
|
let rec concreteHandleToTypeDefn
|
||||||
|
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
|
||||||
|
(handle : ConcreteTypeHandle)
|
||||||
|
(concreteTypes : AllConcreteTypes)
|
||||||
|
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||||
|
: TypeDefn
|
||||||
|
=
|
||||||
|
match handle with
|
||||||
|
| ConcreteTypeHandle.Byref elementHandle ->
|
||||||
|
let elementType =
|
||||||
|
concreteHandleToTypeDefn baseClassTypes elementHandle concreteTypes assemblies
|
||||||
|
|
||||||
|
TypeDefn.Byref elementType
|
||||||
|
| ConcreteTypeHandle.Pointer elementHandle ->
|
||||||
|
let elementType =
|
||||||
|
concreteHandleToTypeDefn baseClassTypes elementHandle concreteTypes assemblies
|
||||||
|
|
||||||
|
TypeDefn.Pointer elementType
|
||||||
|
| ConcreteTypeHandle.Concrete _ ->
|
||||||
|
match AllConcreteTypes.lookup handle concreteTypes with
|
||||||
|
| None -> failwith "Logic error: handle not found"
|
||||||
|
| Some concreteType ->
|
||||||
|
|
||||||
|
// Determine SignatureTypeKind
|
||||||
|
let assy = assemblies.[concreteType.Assembly.FullName]
|
||||||
|
let typeDef = assy.TypeDefs.[concreteType.Definition.Get]
|
||||||
|
// Determine SignatureTypeKind from base type
|
||||||
|
let baseType =
|
||||||
|
typeDef.BaseType
|
||||||
|
|> DumpedAssembly.resolveBaseType baseClassTypes assemblies assy.Name
|
||||||
|
|
||||||
|
let signatureTypeKind =
|
||||||
|
match baseType with
|
||||||
|
| ResolvedBaseType.Enum
|
||||||
|
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
|
||||||
|
| ResolvedBaseType.Object
|
||||||
|
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
|
||||||
|
|
||||||
|
if concreteType.Generics.IsEmpty then
|
||||||
|
TypeDefn.FromDefinition (concreteType.Definition, concreteType.Assembly.FullName, signatureTypeKind)
|
||||||
|
else
|
||||||
|
// Recursively convert generic arguments
|
||||||
|
let genericArgs =
|
||||||
|
concreteType.Generics
|
||||||
|
|> List.map (fun h -> concreteHandleToTypeDefn baseClassTypes h concreteTypes assemblies)
|
||||||
|
|> ImmutableArray.CreateRange
|
||||||
|
|
||||||
|
let baseDef =
|
||||||
|
TypeDefn.FromDefinition (concreteType.Definition, concreteType.Assembly.FullName, signatureTypeKind)
|
||||||
|
|
||||||
|
TypeDefn.GenericInstantiation (baseDef, genericArgs)
|
@@ -26,6 +26,7 @@
|
|||||||
<Compile Include="ExportedType.fs" />
|
<Compile Include="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>
|
||||||
|
@@ -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
|
||||||
|
@@ -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" />
|
||||||
|
120
WoofWare.PawPrint.Test/sourcesPure/CrossAssemblyTypes.cs
Normal file
120
WoofWare.PawPrint.Test/sourcesPure/CrossAssemblyTypes.cs
Normal file
@@ -0,0 +1,120 @@
|
|||||||
|
using System;
|
||||||
|
using System.Collections.Generic;
|
||||||
|
using System.Collections;
|
||||||
|
|
||||||
|
// Test cross-assembly type resolution using standard library types
|
||||||
|
public class CrossAssemblyTypeTest
|
||||||
|
{
|
||||||
|
public static int TestSystemTypes()
|
||||||
|
{
|
||||||
|
// Test various System types to ensure proper assembly resolution
|
||||||
|
|
||||||
|
// System.DateTime
|
||||||
|
var date = new DateTime(2023, 1, 1);
|
||||||
|
if (date.Year != 2023) return 1;
|
||||||
|
|
||||||
|
// System.Guid
|
||||||
|
var guid = Guid.Empty;
|
||||||
|
if (guid != Guid.Empty) return 2;
|
||||||
|
|
||||||
|
// System.TimeSpan
|
||||||
|
var timeSpan = TimeSpan.FromMinutes(30);
|
||||||
|
if (timeSpan.TotalMinutes != 30) return 3;
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
public static int TestCollectionTypes()
|
||||||
|
{
|
||||||
|
// Test various collection types from different assemblies
|
||||||
|
|
||||||
|
// Dictionary<TKey, TValue>
|
||||||
|
var dict = new Dictionary<string, int>();
|
||||||
|
dict["test"] = 42;
|
||||||
|
if (dict["test"] != 42) return 1;
|
||||||
|
|
||||||
|
// HashSet<T>
|
||||||
|
var hashSet = new HashSet<int>();
|
||||||
|
hashSet.Add(1);
|
||||||
|
hashSet.Add(2);
|
||||||
|
hashSet.Add(1); // duplicate
|
||||||
|
if (hashSet.Count != 2) return 2;
|
||||||
|
|
||||||
|
// Queue<T>
|
||||||
|
var queue = new Queue<string>();
|
||||||
|
queue.Enqueue("first");
|
||||||
|
queue.Enqueue("second");
|
||||||
|
if (queue.Dequeue() != "first") return 3;
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
public static int TestGenericInterfaces()
|
||||||
|
{
|
||||||
|
// Test generic interfaces across assemblies
|
||||||
|
|
||||||
|
var list = new List<int> { 1, 2, 3 };
|
||||||
|
|
||||||
|
// IEnumerable<T>
|
||||||
|
IEnumerable<int> enumerable = list;
|
||||||
|
int count = 0;
|
||||||
|
foreach (int item in enumerable)
|
||||||
|
{
|
||||||
|
count++;
|
||||||
|
}
|
||||||
|
if (count != 3) return 1;
|
||||||
|
|
||||||
|
// ICollection<T>
|
||||||
|
ICollection<int> collection = list;
|
||||||
|
if (collection.Count != 3) return 2;
|
||||||
|
|
||||||
|
// IList<T>
|
||||||
|
IList<int> ilist = list;
|
||||||
|
if (ilist[0] != 1) return 3;
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// Test Array.Empty<T> which was mentioned in the diff as a specific case
|
||||||
|
public class ArrayEmptyTest
|
||||||
|
{
|
||||||
|
public static int TestArrayEmpty()
|
||||||
|
{
|
||||||
|
// Test Array.Empty<T> for different types
|
||||||
|
var emptyInts = Array.Empty<int>();
|
||||||
|
var emptyStrings = Array.Empty<string>();
|
||||||
|
|
||||||
|
if (emptyInts.Length != 0) return 1;
|
||||||
|
if (emptyStrings.Length != 0) return 2;
|
||||||
|
|
||||||
|
// Verify they are different instances for different types
|
||||||
|
// but same instance for same type
|
||||||
|
var emptyInts2 = Array.Empty<int>();
|
||||||
|
if (!ReferenceEquals(emptyInts, emptyInts2)) return 3;
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
class Program
|
||||||
|
{
|
||||||
|
static int Main(string[] args)
|
||||||
|
{
|
||||||
|
int result;
|
||||||
|
|
||||||
|
result = CrossAssemblyTypeTest.TestSystemTypes();
|
||||||
|
if (result != 0) return 100 + result;
|
||||||
|
|
||||||
|
result = CrossAssemblyTypeTest.TestCollectionTypes();
|
||||||
|
if (result != 0) return 200 + result;
|
||||||
|
|
||||||
|
result = CrossAssemblyTypeTest.TestGenericInterfaces();
|
||||||
|
if (result != 0) return 300 + result;
|
||||||
|
|
||||||
|
result = ArrayEmptyTest.TestArrayEmpty();
|
||||||
|
if (result != 0) return 400 + result;
|
||||||
|
|
||||||
|
return 0; // All tests passed
|
||||||
|
}
|
||||||
|
}
|
142
WoofWare.PawPrint.Test/sourcesPure/GenericEdgeCases.cs
Normal file
142
WoofWare.PawPrint.Test/sourcesPure/GenericEdgeCases.cs
Normal file
@@ -0,0 +1,142 @@
|
|||||||
|
using System;
|
||||||
|
using System.Collections.Generic;
|
||||||
|
|
||||||
|
// Test edge cases with generic parameters as mentioned in the diff
|
||||||
|
public class GenericParameterEdgeCases
|
||||||
|
{
|
||||||
|
// Test method with multiple generic parameters
|
||||||
|
public static T2 Convert<T1, T2>(T1 input, Func<T1, T2> converter)
|
||||||
|
{
|
||||||
|
return converter(input);
|
||||||
|
}
|
||||||
|
|
||||||
|
// Test nested generic method calls
|
||||||
|
public static List<T> WrapInList<T>(T item)
|
||||||
|
{
|
||||||
|
var list = new List<T>();
|
||||||
|
list.Add(item);
|
||||||
|
return list;
|
||||||
|
}
|
||||||
|
|
||||||
|
public static int TestMultipleGenericParameters()
|
||||||
|
{
|
||||||
|
// Test Convert method with different type combinations
|
||||||
|
string result1 = Convert<int, string>(42, x => x.ToString());
|
||||||
|
if (result1 != "42") return 1;
|
||||||
|
|
||||||
|
int result2 = Convert<string, int>("123", x => int.Parse(x));
|
||||||
|
if (result2 != 123) return 2;
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
public static int TestNestedGenericMethodCalls()
|
||||||
|
{
|
||||||
|
// Test calling generic method from within another generic method
|
||||||
|
var intList = WrapInList<int>(42);
|
||||||
|
if (intList.Count != 1) return 1;
|
||||||
|
if (intList[0] != 42) return 2;
|
||||||
|
|
||||||
|
var stringList = WrapInList<string>("test");
|
||||||
|
if (stringList.Count != 1) return 3;
|
||||||
|
if (stringList[0] != "test") return 4;
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// Test deeply nested generic types
|
||||||
|
public class DeepNestingTest
|
||||||
|
{
|
||||||
|
public static int TestDeeplyNestedGenerics()
|
||||||
|
{
|
||||||
|
// Test Dictionary<string, List<Dictionary<int, string>>>
|
||||||
|
var complexType = new Dictionary<string, List<Dictionary<int, string>>>();
|
||||||
|
|
||||||
|
var innerDict = new Dictionary<int, string>();
|
||||||
|
innerDict[1] = "one";
|
||||||
|
innerDict[2] = "two";
|
||||||
|
|
||||||
|
var listOfDicts = new List<Dictionary<int, string>>();
|
||||||
|
listOfDicts.Add(innerDict);
|
||||||
|
|
||||||
|
complexType["test"] = listOfDicts;
|
||||||
|
|
||||||
|
if (complexType["test"].Count != 1) return 1;
|
||||||
|
if (complexType["test"][0][1] != "one") return 2;
|
||||||
|
if (complexType["test"][0][2] != "two") return 3;
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// Test generic constraints and inheritance scenarios
|
||||||
|
public class GenericConstraintTest<T> where T : class
|
||||||
|
{
|
||||||
|
private T value;
|
||||||
|
|
||||||
|
public GenericConstraintTest(T val)
|
||||||
|
{
|
||||||
|
value = val;
|
||||||
|
}
|
||||||
|
|
||||||
|
public bool IsNull()
|
||||||
|
{
|
||||||
|
return value == null;
|
||||||
|
}
|
||||||
|
|
||||||
|
public static int TestGenericConstraints()
|
||||||
|
{
|
||||||
|
var test = new GenericConstraintTest<string>("hello");
|
||||||
|
if (test.IsNull()) return 1;
|
||||||
|
|
||||||
|
var nullTest = new GenericConstraintTest<string>(null);
|
||||||
|
if (!nullTest.IsNull()) return 2;
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// Test generic field access scenarios mentioned in the diff
|
||||||
|
public class GenericFieldAccess<T>
|
||||||
|
{
|
||||||
|
public static T DefaultValue = default(T);
|
||||||
|
|
||||||
|
public static int TestStaticGenericField()
|
||||||
|
{
|
||||||
|
// Test that static fields work correctly with generics
|
||||||
|
if (GenericFieldAccess<int>.DefaultValue != 0) return 1;
|
||||||
|
|
||||||
|
// Test that different instantiations have different static fields
|
||||||
|
GenericFieldAccess<int>.DefaultValue = 42;
|
||||||
|
if (GenericFieldAccess<int>.DefaultValue != 42) return 2;
|
||||||
|
if (GenericFieldAccess<string>.DefaultValue != null) return 3;
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
class Program
|
||||||
|
{
|
||||||
|
static int Main(string[] args)
|
||||||
|
{
|
||||||
|
int result;
|
||||||
|
|
||||||
|
result = GenericParameterEdgeCases.TestMultipleGenericParameters();
|
||||||
|
if (result != 0) return 100 + result;
|
||||||
|
|
||||||
|
result = GenericParameterEdgeCases.TestNestedGenericMethodCalls();
|
||||||
|
if (result != 0) return 200 + result;
|
||||||
|
|
||||||
|
result = DeepNestingTest.TestDeeplyNestedGenerics();
|
||||||
|
if (result != 0) return 300 + result;
|
||||||
|
|
||||||
|
result = GenericConstraintTest<string>.TestGenericConstraints();
|
||||||
|
if (result != 0) return 400 + result;
|
||||||
|
|
||||||
|
result = GenericFieldAccess<int>.TestStaticGenericField();
|
||||||
|
if (result != 0) return 500 + result;
|
||||||
|
|
||||||
|
return 0; // All tests passed
|
||||||
|
}
|
||||||
|
}
|
54
WoofWare.PawPrint.Test/sourcesPure/StaticVariables.cs
Normal file
54
WoofWare.PawPrint.Test/sourcesPure/StaticVariables.cs
Normal file
@@ -0,0 +1,54 @@
|
|||||||
|
public class GenericCounter<T>
|
||||||
|
{
|
||||||
|
private static int count = 0;
|
||||||
|
|
||||||
|
public static void Increment()
|
||||||
|
{
|
||||||
|
count++;
|
||||||
|
}
|
||||||
|
|
||||||
|
public static int GetCount()
|
||||||
|
{
|
||||||
|
return count;
|
||||||
|
}
|
||||||
|
|
||||||
|
public static void Reset()
|
||||||
|
{
|
||||||
|
count = 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
class Program
|
||||||
|
{
|
||||||
|
static int Main(string[] argv)
|
||||||
|
{
|
||||||
|
// Test that different generic instantiations have separate static variables
|
||||||
|
|
||||||
|
// Initial state should be 0 for all
|
||||||
|
if (GenericCounter<int>.GetCount() != 0) return 1;
|
||||||
|
if (GenericCounter<string>.GetCount() != 0) return 2;
|
||||||
|
|
||||||
|
// Increment int version 3 times
|
||||||
|
GenericCounter<int>.Increment();
|
||||||
|
GenericCounter<int>.Increment();
|
||||||
|
GenericCounter<int>.Increment();
|
||||||
|
|
||||||
|
// Increment string version 2 times
|
||||||
|
GenericCounter<string>.Increment();
|
||||||
|
GenericCounter<string>.Increment();
|
||||||
|
|
||||||
|
// Verify counts are independent
|
||||||
|
if (GenericCounter<int>.GetCount() != 3) return 3;
|
||||||
|
if (GenericCounter<string>.GetCount() != 2) return 4;
|
||||||
|
|
||||||
|
// Reset int version only
|
||||||
|
GenericCounter<int>.Reset();
|
||||||
|
|
||||||
|
// Verify reset only affected int version
|
||||||
|
if (GenericCounter<int>.GetCount() != 0) return 5;
|
||||||
|
if (GenericCounter<string>.GetCount() != 2) return 6;
|
||||||
|
|
||||||
|
// Test passes - static variables are isolated per generic instantiation
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
}
|
112
WoofWare.PawPrint.Test/sourcesPure/TypeConcretization.cs
Normal file
112
WoofWare.PawPrint.Test/sourcesPure/TypeConcretization.cs
Normal file
@@ -0,0 +1,112 @@
|
|||||||
|
using System;
|
||||||
|
using System.Collections.Generic;
|
||||||
|
|
||||||
|
// Test basic type concretization
|
||||||
|
public class BasicTypeTest
|
||||||
|
{
|
||||||
|
public static int TestBasicTypes()
|
||||||
|
{
|
||||||
|
// Test primitive types
|
||||||
|
int i = 42;
|
||||||
|
string s = "hello";
|
||||||
|
bool b = true;
|
||||||
|
|
||||||
|
if (i != 42) return 1;
|
||||||
|
if (s != "hello") return 2;
|
||||||
|
if (!b) return 3;
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// Test generic type instantiation
|
||||||
|
public class GenericTypeTest<T>
|
||||||
|
{
|
||||||
|
private T value;
|
||||||
|
|
||||||
|
public GenericTypeTest(T val)
|
||||||
|
{
|
||||||
|
value = val;
|
||||||
|
}
|
||||||
|
|
||||||
|
public T GetValue()
|
||||||
|
{
|
||||||
|
return value;
|
||||||
|
}
|
||||||
|
|
||||||
|
public static int TestGenericInstantiation()
|
||||||
|
{
|
||||||
|
var intTest = new GenericTypeTest<int>(123);
|
||||||
|
var stringTest = new GenericTypeTest<string>("test");
|
||||||
|
|
||||||
|
if (intTest.GetValue() != 123) return 1;
|
||||||
|
if (stringTest.GetValue() != "test") return 2;
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// Test nested generic types
|
||||||
|
public class NestedGenericTest
|
||||||
|
{
|
||||||
|
public static int TestNestedGenerics()
|
||||||
|
{
|
||||||
|
var listOfInts = new List<int>();
|
||||||
|
listOfInts.Add(1);
|
||||||
|
listOfInts.Add(2);
|
||||||
|
|
||||||
|
if (listOfInts.Count != 2) return 1;
|
||||||
|
if (listOfInts[0] != 1) return 2;
|
||||||
|
if (listOfInts[1] != 2) return 3;
|
||||||
|
|
||||||
|
var listOfLists = new List<List<int>>();
|
||||||
|
listOfLists.Add(listOfInts);
|
||||||
|
|
||||||
|
if (listOfLists.Count != 1) return 4;
|
||||||
|
if (listOfLists[0].Count != 2) return 5;
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// Test generic methods
|
||||||
|
public class GenericMethodTest
|
||||||
|
{
|
||||||
|
public static T Identity<T>(T input)
|
||||||
|
{
|
||||||
|
return input;
|
||||||
|
}
|
||||||
|
|
||||||
|
public static int TestGenericMethods()
|
||||||
|
{
|
||||||
|
int intResult = Identity<int>(42);
|
||||||
|
string stringResult = Identity<string>("hello");
|
||||||
|
|
||||||
|
if (intResult != 42) return 1;
|
||||||
|
if (stringResult != "hello") return 2;
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
class Program
|
||||||
|
{
|
||||||
|
static int Main(string[] args)
|
||||||
|
{
|
||||||
|
int result;
|
||||||
|
|
||||||
|
result = BasicTypeTest.TestBasicTypes();
|
||||||
|
if (result != 0) return 100 + result;
|
||||||
|
|
||||||
|
result = GenericTypeTest<int>.TestGenericInstantiation();
|
||||||
|
if (result != 0) return 200 + result;
|
||||||
|
|
||||||
|
result = NestedGenericTest.TestNestedGenerics();
|
||||||
|
if (result != 0) return 300 + result;
|
||||||
|
|
||||||
|
result = GenericMethodTest.TestGenericMethods();
|
||||||
|
if (result != 0) return 400 + result;
|
||||||
|
|
||||||
|
return 0; // All tests passed
|
||||||
|
}
|
||||||
|
}
|
@@ -60,22 +60,18 @@ module AbstractMachine =
|
|||||||
|
|
||||||
let delegateToRun = state.ManagedHeap.NonArrayObjects.[delegateToRunAddr]
|
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",
|
||||||
|
@@ -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
|
||||||
|
let visited = Set.add handle visited
|
||||||
|
// Not a known primitive, check if it's a value type or reference type
|
||||||
|
determineZeroForCustomType concreteTypes assemblies corelib handle concreteType typeDef visited
|
||||||
|
else if
|
||||||
|
// Not from corelib or has generics
|
||||||
|
concreteType.Assembly = corelib.Corelib.Name
|
||||||
|
&& typeDef = corelib.Array
|
||||||
|
&& concreteType.Generics.Length = 1
|
||||||
|
then
|
||||||
|
// This is an array type
|
||||||
|
CliType.ObjectRef None, concreteTypes
|
||||||
|
else if
|
||||||
|
// Custom type - now check for cycles
|
||||||
|
Set.contains handle visited
|
||||||
|
then
|
||||||
|
// We're in a cycle - return a default zero value for the type
|
||||||
|
// For value types in cycles, we'll return a null reference as a safe fallback
|
||||||
|
// This should only happen with self-referential types
|
||||||
|
CliType.ObjectRef None, concreteTypes
|
||||||
else
|
else
|
||||||
// TODO: the rest
|
let visited = Set.add handle visited
|
||||||
match signatureTypeKind with
|
// Custom type - need to determine if it's a value type or reference type
|
||||||
| SignatureTypeKind.Unknown -> failwith "todo"
|
determineZeroForCustomType concreteTypes assemblies corelib handle concreteType typeDef visited
|
||||||
| SignatureTypeKind.ValueType ->
|
|
||||||
let fields =
|
|
||||||
typeDef.Fields
|
|
||||||
// oh lord, this is awfully ominous - I really don't want to store the statics here
|
|
||||||
|> List.filter (fun field -> not (field.Attributes.HasFlag FieldAttributes.Static))
|
|
||||||
|> List.map (fun fi ->
|
|
||||||
match zeroOf assemblies corelib assy typeGenerics methodGenerics fi.Signature with
|
|
||||||
| CliTypeResolutionResult.Resolved ty -> Ok (fi.Name, ty)
|
|
||||||
| CliTypeResolutionResult.FirstLoad a -> Error a
|
|
||||||
)
|
|
||||||
|> Result.allOkOrError
|
|
||||||
|
|
||||||
match fields with
|
and private determineZeroForCustomType
|
||||||
| Error (_, []) -> failwith "logic error"
|
(concreteTypes : AllConcreteTypes)
|
||||||
| Error (_, f :: _) -> CliTypeResolutionResult.FirstLoad f
|
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||||
| Ok fields ->
|
(corelib : BaseClassTypes<DumpedAssembly>)
|
||||||
|
(handle : ConcreteTypeHandle)
|
||||||
|
(concreteType : ConcreteType<ConcreteTypeHandle>)
|
||||||
|
(typeDef : WoofWare.PawPrint.TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>)
|
||||||
|
(visited : Set<ConcreteTypeHandle>)
|
||||||
|
: CliType * AllConcreteTypes
|
||||||
|
=
|
||||||
|
|
||||||
CliType.ValueType fields |> CliTypeResolutionResult.Resolved
|
// Determine if this is a value type by checking inheritance
|
||||||
| SignatureTypeKind.Class -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved
|
let isValueType =
|
||||||
| _ -> raise (ArgumentOutOfRangeException ())
|
match DumpedAssembly.resolveBaseType corelib assemblies typeDef.Assembly typeDef.BaseType with
|
||||||
| TypeDefn.GenericInstantiation (generic, args) ->
|
| ResolvedBaseType.ValueType
|
||||||
zeroOf assemblies corelib assy (Some args) methodGenerics generic
|
| ResolvedBaseType.Enum -> true
|
||||||
| TypeDefn.FunctionPointer typeMethodSignature -> failwith "todo"
|
| ResolvedBaseType.Delegate -> false // Delegates are reference types
|
||||||
| TypeDefn.GenericTypeParameter index ->
|
| ResolvedBaseType.Object -> false
|
||||||
// TODO: can generics depend on other generics? presumably, so we pass the array down again
|
|
||||||
match typeGenerics with
|
if isValueType then
|
||||||
| None -> failwith "asked for a type parameter of generic type, but no generics in scope"
|
// It's a value type - need to create zero values for all non-static fields
|
||||||
| Some generics -> zeroOf assemblies corelib assy (Some generics) methodGenerics generics.[index]
|
let mutable currentConcreteTypes = concreteTypes
|
||||||
| TypeDefn.GenericMethodParameter index ->
|
|
||||||
match methodGenerics with
|
let fieldZeros =
|
||||||
| None -> failwith "asked for a method parameter of generic type, but no generics in scope"
|
typeDef.Fields
|
||||||
| Some generics -> zeroOf assemblies corelib assy typeGenerics (Some generics) generics.[index]
|
|> List.filter (fun field -> not (field.Attributes.HasFlag FieldAttributes.Static))
|
||||||
| TypeDefn.Void -> failwith "should never construct an element of type Void"
|
|> List.map (fun field ->
|
||||||
|
// Need to concretize the field type with the concrete type's generics
|
||||||
|
let fieldTypeDefn = field.Signature
|
||||||
|
|
||||||
|
let fieldHandle, updatedConcreteTypes =
|
||||||
|
concretizeFieldType currentConcreteTypes assemblies corelib concreteType fieldTypeDefn
|
||||||
|
|
||||||
|
currentConcreteTypes <- updatedConcreteTypes
|
||||||
|
|
||||||
|
let fieldZero, updatedConcreteTypes2 =
|
||||||
|
zeroOfWithVisited currentConcreteTypes assemblies corelib fieldHandle visited
|
||||||
|
|
||||||
|
currentConcreteTypes <- updatedConcreteTypes2
|
||||||
|
(field.Name, fieldZero)
|
||||||
|
)
|
||||||
|
|
||||||
|
CliType.ValueType fieldZeros, currentConcreteTypes
|
||||||
|
else
|
||||||
|
// It's a reference type
|
||||||
|
CliType.ObjectRef None, concreteTypes
|
||||||
|
|
||||||
|
and private concretizeFieldType
|
||||||
|
(concreteTypes : AllConcreteTypes)
|
||||||
|
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||||
|
(corelib : BaseClassTypes<DumpedAssembly>)
|
||||||
|
(declaringType : ConcreteType<ConcreteTypeHandle>)
|
||||||
|
(fieldType : TypeDefn)
|
||||||
|
: ConcreteTypeHandle * AllConcreteTypes
|
||||||
|
=
|
||||||
|
|
||||||
|
// Create a concretization context
|
||||||
|
let ctx =
|
||||||
|
{
|
||||||
|
TypeConcretization.ConcretizationContext.InProgress = ImmutableDictionary.Empty
|
||||||
|
TypeConcretization.ConcretizationContext.ConcreteTypes = concreteTypes
|
||||||
|
TypeConcretization.ConcretizationContext.LoadedAssemblies = assemblies
|
||||||
|
TypeConcretization.ConcretizationContext.BaseTypes = corelib
|
||||||
|
}
|
||||||
|
|
||||||
|
// The field type might reference generic parameters of the declaring type
|
||||||
|
let typeGenerics = declaringType.Generics |> ImmutableArray.CreateRange
|
||||||
|
let methodGenerics = ImmutableArray.Empty // Fields don't have method generics
|
||||||
|
|
||||||
|
let loadAssembly
|
||||||
|
(assyName : AssemblyName)
|
||||||
|
(ref : AssemblyReferenceHandle)
|
||||||
|
: (ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
|
||||||
|
=
|
||||||
|
match assemblies.TryGetValue assyName.FullName with
|
||||||
|
| true, currentAssy ->
|
||||||
|
let targetAssyRef = currentAssy.AssemblyReferences.[ref]
|
||||||
|
|
||||||
|
match assemblies.TryGetValue targetAssyRef.Name.FullName with
|
||||||
|
| true, targetAssy -> assemblies, targetAssy
|
||||||
|
| false, _ ->
|
||||||
|
failwithf "Assembly %s not loaded when trying to resolve reference" targetAssyRef.Name.FullName
|
||||||
|
| false, _ -> failwithf "Current assembly %s not loaded when trying to resolve reference" assyName.FullName
|
||||||
|
|
||||||
|
let handle, newCtx =
|
||||||
|
TypeConcretization.concretizeType
|
||||||
|
ctx
|
||||||
|
loadAssembly
|
||||||
|
declaringType.Assembly
|
||||||
|
typeGenerics
|
||||||
|
methodGenerics
|
||||||
|
fieldType
|
||||||
|
|
||||||
|
handle, newCtx.ConcreteTypes
|
||||||
|
File diff suppressed because it is too large
Load Diff
@@ -6,7 +6,7 @@ type MethodReturnState =
|
|||||||
{
|
{
|
||||||
/// Index in the MethodStates array of a ThreadState
|
/// 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
|
||||||
|
|
||||||
{
|
{
|
||||||
|
@@ -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")
|
|
||||||
|> MethodInfo.mapMethodGenerics (fun _ -> failwith "Refusing to execute generic main method")
|
|
||||||
|
|
||||||
let rec computeState (baseClassTypes : BaseClassTypes<DumpedAssembly> option) (state : IlMachineState) =
|
// Find the core library by traversing the type hierarchy of the main method's declaring type
|
||||||
// The thread's state is slightly fake: we will need to put arguments onto the stack before actually
|
// until we reach System.Object
|
||||||
// executing the main method.
|
let rec handleBaseTypeInfo
|
||||||
// We construct the thread here before we are entirely ready, because we need a thread from which to
|
(state : IlMachineState)
|
||||||
// initialise the class containing the main method.
|
(baseTypeInfo : BaseTypeInfo)
|
||||||
// Once we've obtained e.g. the String and Array classes, we can populate the args array.
|
(currentAssembly : DumpedAssembly)
|
||||||
match
|
(continueWithGeneric :
|
||||||
MethodState.Empty
|
IlMachineState
|
||||||
(Option.toObj baseClassTypes)
|
-> TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>
|
||||||
state._LoadedAssemblies
|
-> DumpedAssembly
|
||||||
dumped
|
-> IlMachineState * BaseClassTypes<DumpedAssembly> option)
|
||||||
// pretend there are no instructions, so we avoid preparing anything
|
(continueWithResolved :
|
||||||
{ mainMethod with
|
IlMachineState
|
||||||
Instructions = Some (MethodInstructions.onlyRet ())
|
-> TypeInfo<TypeDefn, TypeDefn>
|
||||||
}
|
-> DumpedAssembly
|
||||||
None
|
-> IlMachineState * BaseClassTypes<DumpedAssembly> option)
|
||||||
(ImmutableArray.CreateRange [ CliType.ObjectRef None ])
|
: IlMachineState * BaseClassTypes<DumpedAssembly> option
|
||||||
None
|
=
|
||||||
with
|
match baseTypeInfo with
|
||||||
| Ok meth -> IlMachineState.addThread meth dumped.Name state, baseClassTypes
|
| BaseTypeInfo.TypeRef typeRefHandle ->
|
||||||
| Error requiresRefs ->
|
// Look up the TypeRef from the handle
|
||||||
let state =
|
let typeRef = currentAssembly.TypeRefs.[typeRefHandle]
|
||||||
(state, requiresRefs)
|
|
||||||
||> List.fold (fun state ref ->
|
let rec go state =
|
||||||
let handle, referencingAssy = ref.Handle
|
// Resolve the type reference to find which assembly it's in
|
||||||
let referencingAssy = state.LoadedAssembly referencingAssy |> Option.get
|
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, _, _ =
|
let state, _, _ =
|
||||||
IlMachineState.loadAssembly loggerFactory referencingAssy handle state
|
IlMachineState.loadAssembly
|
||||||
|
loggerFactory
|
||||||
|
state._LoadedAssemblies.[definedIn.FullName]
|
||||||
|
handle
|
||||||
|
state
|
||||||
|
|
||||||
|
go state
|
||||||
|
| TypeResolutionResult.Resolved (resolvedAssembly, resolvedType) ->
|
||||||
|
continueWithResolved state resolvedType resolvedAssembly
|
||||||
|
|
||||||
|
go state
|
||||||
|
| BaseTypeInfo.TypeDef typeDefHandle ->
|
||||||
|
// Base type is in the same assembly
|
||||||
|
let baseType = currentAssembly.TypeDefs.[typeDefHandle]
|
||||||
|
continueWithGeneric state baseType currentAssembly
|
||||||
|
| BaseTypeInfo.TypeSpec _ -> failwith "Type specs not yet supported in base type traversal"
|
||||||
|
| BaseTypeInfo.ForeignAssemblyType (assemblyName, typeDefHandle) ->
|
||||||
|
// Base type is in a foreign assembly
|
||||||
|
match state._LoadedAssemblies.TryGetValue assemblyName.FullName with
|
||||||
|
| true, foreignAssembly ->
|
||||||
|
let baseType = foreignAssembly.TypeDefs.[typeDefHandle]
|
||||||
|
continueWithGeneric state baseType foreignAssembly
|
||||||
|
| false, _ -> failwith $"Foreign assembly {assemblyName.FullName} not loaded"
|
||||||
|
|
||||||
|
let rec findCoreLibraryAssemblyFromGeneric
|
||||||
|
(state : IlMachineState)
|
||||||
|
(currentType : TypeInfo<WoofWare.PawPrint.GenericParameter, TypeDefn>)
|
||||||
|
(currentAssembly : DumpedAssembly)
|
||||||
|
=
|
||||||
|
match currentType.BaseType with
|
||||||
|
| None ->
|
||||||
|
// We've reached the root (System.Object), so this assembly contains the core library
|
||||||
|
let baseTypes = Corelib.getBaseTypes currentAssembly
|
||||||
|
state, Some baseTypes
|
||||||
|
| Some baseTypeInfo ->
|
||||||
|
handleBaseTypeInfo
|
||||||
|
state
|
||||||
|
baseTypeInfo
|
||||||
|
currentAssembly
|
||||||
|
findCoreLibraryAssemblyFromGeneric
|
||||||
|
findCoreLibraryAssemblyFromResolved
|
||||||
|
|
||||||
|
and findCoreLibraryAssemblyFromResolved
|
||||||
|
(state : IlMachineState)
|
||||||
|
(currentType : TypeInfo<TypeDefn, TypeDefn>)
|
||||||
|
(currentAssembly : DumpedAssembly)
|
||||||
|
=
|
||||||
|
match currentType.BaseType with
|
||||||
|
| None ->
|
||||||
|
// We've reached the root (System.Object), so this assembly contains the core library
|
||||||
|
let baseTypes = Corelib.getBaseTypes currentAssembly
|
||||||
|
state, Some baseTypes
|
||||||
|
| Some baseTypeInfo ->
|
||||||
|
handleBaseTypeInfo
|
||||||
|
state
|
||||||
|
baseTypeInfo
|
||||||
|
currentAssembly
|
||||||
|
findCoreLibraryAssemblyFromGeneric
|
||||||
|
findCoreLibraryAssemblyFromResolved
|
||||||
|
|
||||||
|
let rec computeState (baseClassTypes : BaseClassTypes<DumpedAssembly> option) (state : IlMachineState) =
|
||||||
|
match baseClassTypes with
|
||||||
|
| Some baseTypes ->
|
||||||
|
// We already have base class types, can directly create the concretized method
|
||||||
|
// Use the original method from metadata, but convert FakeUnit to TypeDefn
|
||||||
|
let rawMainMethod =
|
||||||
|
mainMethodFromMetadata
|
||||||
|
|> MethodInfo.mapTypeGenerics (fun i _ -> TypeDefn.GenericTypeParameter i)
|
||||||
|
|
||||||
|
let state, concretizedMainMethod, _ =
|
||||||
|
IlMachineState.concretizeMethodWithTypeGenerics
|
||||||
|
loggerFactory
|
||||||
|
baseTypes
|
||||||
|
ImmutableArray.Empty // No type generics for main method's declaring type
|
||||||
|
{ rawMainMethod with
|
||||||
|
Instructions = Some (MethodInstructions.onlyRet ())
|
||||||
|
}
|
||||||
|
None
|
||||||
|
dumped.Name
|
||||||
|
ImmutableArray.Empty
|
||||||
state
|
state
|
||||||
)
|
|
||||||
|
|
||||||
let corelib =
|
// Create the method state with the concretized method
|
||||||
let coreLib =
|
match
|
||||||
state._LoadedAssemblies.Keys
|
MethodState.Empty
|
||||||
|> Seq.tryFind (fun x -> x.StartsWith ("System.Private.CoreLib, ", StringComparison.Ordinal))
|
state.ConcreteTypes
|
||||||
|
baseTypes
|
||||||
|
state._LoadedAssemblies
|
||||||
|
dumped
|
||||||
|
concretizedMainMethod
|
||||||
|
ImmutableArray.Empty
|
||||||
|
(ImmutableArray.CreateRange [ CliType.ObjectRef None ])
|
||||||
|
None
|
||||||
|
with
|
||||||
|
| Ok concretizedMeth -> IlMachineState.addThread concretizedMeth dumped.Name state, Some baseTypes
|
||||||
|
| Error _ -> failwith "Unexpected failure creating method state with concretized method"
|
||||||
|
| None ->
|
||||||
|
// We need to discover the core library by traversing the type hierarchy
|
||||||
|
let mainMethodType =
|
||||||
|
dumped.TypeDefs.[mainMethodFromMetadata.DeclaringType.Definition.Get]
|
||||||
|
|
||||||
coreLib
|
let state, baseTypes =
|
||||||
|> Option.map (fun coreLib -> state._LoadedAssemblies.[coreLib] |> Corelib.getBaseTypes)
|
findCoreLibraryAssemblyFromGeneric state mainMethodType dumped
|
||||||
|
|
||||||
computeState corelib state
|
computeState baseTypes state
|
||||||
|
|
||||||
let (state, mainThread), baseClassTypes =
|
let (state, mainThread), baseClassTypes = state |> computeState None
|
||||||
IlMachineState.initial loggerFactory dotnetRuntimeDirs dumped
|
|
||||||
|> computeState None
|
// Now that we have base class types, concretize the main method for use in the rest of the function
|
||||||
|
let state, concretizedMainMethod, mainTypeHandle =
|
||||||
|
match baseClassTypes with
|
||||||
|
| Some baseTypes ->
|
||||||
|
let rawMainMethod =
|
||||||
|
mainMethodFromMetadata
|
||||||
|
|> MethodInfo.mapTypeGenerics (fun i _ -> TypeDefn.GenericTypeParameter i)
|
||||||
|
|
||||||
|
IlMachineState.concretizeMethodWithTypeGenerics
|
||||||
|
loggerFactory
|
||||||
|
baseTypes
|
||||||
|
ImmutableArray.Empty // No type generics for main method's declaring type
|
||||||
|
rawMainMethod
|
||||||
|
None
|
||||||
|
dumped.Name
|
||||||
|
ImmutableArray.Empty
|
||||||
|
state
|
||||||
|
| None -> failwith "Expected base class types to be available at this point"
|
||||||
|
|
||||||
let rec loadInitialState (state : IlMachineState) =
|
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"
|
||||||
|
@@ -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
|
||||||
|
@@ -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 ->
|
||||||
|
@@ -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,34 +58,52 @@ 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 =
|
||||||
| NothingToDo state ->
|
IlMachineState.concretizeMethodForExecution
|
||||||
state.WithThreadSwitchedToAssembly methodToCall.DeclaringType.Assembly thread
|
|
||||||
|> fst
|
|
||||||
|> IlMachineState.callMethodInActiveAssembly
|
|
||||||
loggerFactory
|
loggerFactory
|
||||||
baseClassTypes
|
baseClassTypes
|
||||||
thread
|
thread
|
||||||
true
|
|
||||||
methodGenerics
|
|
||||||
methodToCall
|
methodToCall
|
||||||
|
methodGenerics
|
||||||
|
typeArgsFromMetadata
|
||||||
|
state
|
||||||
|
|
||||||
|
match IlMachineState.loadClass loggerFactory baseClassTypes declaringTypeHandle thread state with
|
||||||
|
| NothingToDo state ->
|
||||||
|
let state, _ =
|
||||||
|
state.WithThreadSwitchedToAssembly methodToCall.DeclaringType.Assembly thread
|
||||||
|
|
||||||
|
let threadState = state.ThreadState.[thread]
|
||||||
|
|
||||||
|
IlMachineState.callMethod
|
||||||
|
loggerFactory
|
||||||
|
baseClassTypes
|
||||||
None
|
None
|
||||||
|
None
|
||||||
|
false
|
||||||
|
true
|
||||||
|
concretizedMethod.Generics
|
||||||
|
concretizedMethod
|
||||||
|
thread
|
||||||
|
threadState
|
||||||
|
state,
|
||||||
|
WhatWeDid.Executed
|
||||||
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
|
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
|
||||||
|
|
||||||
| Callvirt ->
|
| Callvirt ->
|
||||||
|
|
||||||
// TODO: this is presumably super incomplete
|
// TODO: this is presumably super incomplete
|
||||||
let state, method, generics =
|
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]
|
||||||
@@ -96,9 +114,9 @@ module internal UnaryMetadataIlOp =
|
|||||||
activeAssy.Methods.[token]
|
activeAssy.Methods.[token]
|
||||||
|> MethodInfo.mapTypeGenerics (fun i _ -> spec.Signature.[i])
|
|> MethodInfo.mapTypeGenerics (fun i _ -> spec.Signature.[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
|
||||||
@@ -109,10 +127,10 @@ module internal UnaryMetadataIlOp =
|
|||||||
|
|
||||||
match method with
|
match method with
|
||||||
| Choice2Of2 _field -> failwith "tried to Callvirt a field"
|
| Choice2Of2 _field -> failwith "tried to Callvirt a field"
|
||||||
| Choice1Of2 method -> state, method, Some spec.Signature
|
| Choice1Of2 method -> state, method, Some spec.Signature, Some extractedTypeArgs
|
||||||
| k -> failwith $"Unrecognised kind: %O{k}"
|
| 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
|
||||||
@@ -123,35 +141,58 @@ module internal UnaryMetadataIlOp =
|
|||||||
|
|
||||||
match method with
|
match method with
|
||||||
| Choice2Of2 _field -> failwith "tried to Callvirt a field"
|
| Choice2Of2 _field -> failwith "tried to Callvirt 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 method.DeclaringType thread state with
|
// TODO: this is pretty inefficient, we're concretising here and then immediately after in callMethodInActiveAssembly
|
||||||
|
let state, concretizedMethod, declaringTypeHandle =
|
||||||
|
IlMachineState.concretizeMethodForExecution
|
||||||
|
loggerFactory
|
||||||
|
baseClassTypes
|
||||||
|
thread
|
||||||
|
methodToCall
|
||||||
|
methodGenerics
|
||||||
|
typeArgsFromMetadata
|
||||||
|
state
|
||||||
|
|
||||||
|
match IlMachineState.loadClass loggerFactory baseClassTypes declaringTypeHandle thread state with
|
||||||
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
|
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
|
||||||
| NothingToDo state ->
|
| NothingToDo state ->
|
||||||
|
|
||||||
state.WithThreadSwitchedToAssembly method.DeclaringType.Assembly thread
|
state.WithThreadSwitchedToAssembly methodToCall.DeclaringType.Assembly thread
|
||||||
|> fst
|
|> fst
|
||||||
|> IlMachineState.callMethodInActiveAssembly loggerFactory baseClassTypes thread true generics method None
|
|> IlMachineState.callMethodInActiveAssembly
|
||||||
|
loggerFactory
|
||||||
|
baseClassTypes
|
||||||
|
thread
|
||||||
|
true
|
||||||
|
methodGenerics
|
||||||
|
methodToCall
|
||||||
|
None
|
||||||
|
typeArgsFromMetadata
|
||||||
|
|
||||||
| Castclass -> failwith "TODO: Castclass unimplemented"
|
| 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 =
|
||||||
TypeDefn.FromDefinition (
|
if defn.Generics.IsEmpty then
|
||||||
ComparableTypeDefinitionHandle.Make defn.TypeDefHandle,
|
TypeDefn.FromDefinition (
|
||||||
defn.Assembly.Name,
|
ComparableTypeDefinitionHandle.Make defn.TypeDefHandle,
|
||||||
signatureTypeKind
|
defn.Assembly.FullName,
|
||||||
)
|
signatureTypeKind
|
||||||
|
)
|
||||||
|
else
|
||||||
|
// Preserve the generic instantiation by converting GenericParameters to TypeDefn.GenericTypeParameter
|
||||||
|
let genericDef =
|
||||||
|
TypeDefn.FromDefinition (
|
||||||
|
ComparableTypeDefinitionHandle.Make defn.TypeDefHandle,
|
||||||
|
defn.Assembly.FullName,
|
||||||
|
signatureTypeKind
|
||||||
|
)
|
||||||
|
|
||||||
|
let genericArgs =
|
||||||
|
defn.Generics
|
||||||
|
|> Seq.mapi (fun i _ -> TypeDefn.GenericTypeParameter i)
|
||||||
|
|> ImmutableArray.CreateRange
|
||||||
|
|
||||||
|
TypeDefn.GenericInstantiation (genericDef, genericArgs)
|
||||||
|
|
||||||
state, result, assy
|
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,16 +865,19 @@ 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 =
|
||||||
loggerFactory
|
IlMachineState.resolveTypeFromSpecConcrete
|
||||||
baseClassTypes
|
loggerFactory
|
||||||
spec
|
baseClassTypes
|
||||||
assy
|
spec
|
||||||
declaringTypeGenerics
|
assy
|
||||||
currentMethod.Generics
|
declaringTypeGenerics
|
||||||
state
|
currentMethod.Generics
|
||||||
|
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,16 +935,19 @@ 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 =
|
||||||
loggerFactory
|
IlMachineState.resolveTypeFromSpecConcrete
|
||||||
baseClassTypes
|
loggerFactory
|
||||||
spec
|
baseClassTypes
|
||||||
assy
|
spec
|
||||||
declaringTypeGenerics
|
assy
|
||||||
currentMethod.Generics
|
declaringTypeGenerics
|
||||||
state
|
currentMethod.Generics
|
||||||
|
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
|
||||||
|
|
||||||
|
@@ -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
|
||||||
|
Reference in New Issue
Block a user