Concretize all base class types eagerly (#122)

WoofWare.PawPrint.Domain/Constants.fs

@@ -11,3 +11,6 @@ module Constants =
 
     [<Literal>]
     let DEFAULT_STRUCT_ALIGNMENT = 8
+
+    [<Literal>]
+    let NATIVE_INT_SIZE = 8

WoofWare.PawPrint.Domain/TypeDefn.fs

@@ -167,8 +167,8 @@ module PrimitiveType =
         | PrimitiveType.Double -> 8
         | PrimitiveType.String -> 8
         | PrimitiveType.TypedReference -> failwith "todo"
-        | PrimitiveType.IntPtr -> 8
-        | PrimitiveType.UIntPtr -> 8
+        | PrimitiveType.IntPtr -> NATIVE_INT_SIZE
+        | PrimitiveType.UIntPtr -> NATIVE_INT_SIZE
         | PrimitiveType.Object -> 8
 
 type TypeDefn =

WoofWare.PawPrint.Domain/WoofWare.PawPrint.Domain.fsproj

@@ -7,6 +7,7 @@
 
     <ItemGroup>
         <Compile Include="StringToken.fs" />
+        <Compile Include="Constants.fs" />
         <Compile Include="ImmutableArray.fs" />
         <Compile Include="Tokens.fs" />
         <Compile Include="TypeRef.fs" />

WoofWare.PawPrint.Test/sourcesPure/OverlappingStructs.cs

@@ -323,10 +323,10 @@ public class StructLayoutTests
     {
         int result = 0;
 
-        result = TestSequentialLayout();
+        result = TestExplicitUnion();
         if (result != 0) return result;
 
-        result = TestExplicitUnion();
+        result = TestSequentialLayout();
         if (result != 0) return result;
 
         result = TestFixedSizeStruct();

WoofWare.PawPrint/BasicCliType.fs

@@ -2,7 +2,7 @@ namespace WoofWare.PawPrint
 
 open System.Collections.Immutable
 open System.Reflection
-open System.Reflection.Metadata
+open Checked
 
 /// Source:
 /// Table I.6: Data Types Directly Supported by the CLI
@@ -68,6 +68,7 @@ type NativeIntSource =
     | ManagedPointer of ManagedPointerSource
     | FunctionPointer of MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle>
     | TypeHandlePtr of ConcreteTypeHandle
+    | FieldHandlePtr of int64
 
     override this.ToString () : string =
         match this with
@@ -76,12 +77,14 @@ type NativeIntSource =
         | NativeIntSource.FunctionPointer methodDefinition ->
             $"<pointer to {methodDefinition.Name} in {methodDefinition.DeclaringType.Assembly.Name}>"
         | NativeIntSource.TypeHandlePtr ptr -> $"<type ID %O{ptr}>"
+        | NativeIntSource.FieldHandlePtr ptr -> $"<field ID %O{ptr}>"
 
 [<RequireQualifiedAccess>]
 module NativeIntSource =
     let isZero (n : NativeIntSource) : bool =
         match n with
         | NativeIntSource.Verbatim i -> i = 0L
+        | NativeIntSource.FieldHandlePtr _
         | NativeIntSource.TypeHandlePtr _ -> false
         | NativeIntSource.FunctionPointer _ -> failwith "TODO"
         | NativeIntSource.ManagedPointer src ->
@@ -93,6 +96,7 @@ module NativeIntSource =
         match n with
         | NativeIntSource.Verbatim i -> i >= 0L
         | NativeIntSource.FunctionPointer _ -> failwith "TODO"
+        | NativeIntSource.FieldHandlePtr _
         | NativeIntSource.TypeHandlePtr _ -> true
         | NativeIntSource.ManagedPointer _ -> true
 
@@ -131,7 +135,8 @@ type CliNumericType =
         | CliNumericType.Float64 _ -> 8
 
 type CliRuntimePointer =
-    | Unmanaged of int64
+    | Verbatim of int64
+    | FieldRegistryHandle of int64
     | Managed of ManagedPointerSource
 
 type SizeofResult =
@@ -203,6 +208,7 @@ and private CliConcreteField =
         Size : int
         Alignment : int
         ConfiguredOffset : int option
+        EditedAtTime : uint64
     }
 
     static member ToCliField (this : CliConcreteField) : CliField =
@@ -217,6 +223,9 @@ and CliValueType =
         {
             _Fields : CliConcreteField list
             Layout : Layout
+            /// We track dependency orderings between updates to overlapping fields with a monotonically increasing
+            /// timestamp.
+            NextTimestamp : uint64
         }
 
     static member private ComputeConcreteFields (layout : Layout) (fields : CliField list) : CliConcreteField list =
@@ -255,6 +264,7 @@ and CliValueType =
                             Size = size.Size
                             Alignment = size.Alignment
                             ConfiguredOffset = field.Offset
+                            EditedAtTime = 0UL
                         }
 
                     alignedOffset + size.Size, concreteField :: acc
@@ -275,6 +285,7 @@ and CliValueType =
                     Size = size.Size
                     Alignment = size.Alignment
                     ConfiguredOffset = field.Offset
+                    EditedAtTime = 0UL
                 }
             )
 
@@ -286,12 +297,16 @@ and CliValueType =
         {
             _Fields = fields
             Layout = layout
+            NextTimestamp = 1UL
         }
 
     static member AddField (f : CliField) (vt : CliValueType) : CliValueType =
         // Recompute all fields with the new one added
         // TODO: the existence of this function at all is rather dubious, but it's there
-        // at the moment to support delegate types
+        // at the moment to support delegate types.
+        // The whole function is just a bodge and it will hopefully go away soon; I just don't know how.
+        let prevFields = vt._Fields |> List.map (fun f -> f.Name, f) |> Map.ofList
+
         let allFields =
             f
             :: (vt._Fields
@@ -306,14 +321,60 @@ and CliValueType =
                     }
                 ))
 
+        let newFields =
+            CliValueType.ComputeConcreteFields vt.Layout allFields
+            |> List.map (fun field ->
+                match Map.tryFind field.Name prevFields with
+                | Some prev ->
+                    { field with
+                        EditedAtTime = prev.EditedAtTime
+                    }
+                | None ->
+                    { field with
+                        EditedAtTime = vt.NextTimestamp
+                    }
+            )
+
         {
-            _Fields = CliValueType.ComputeConcreteFields vt.Layout allFields
+            _Fields = newFields
             Layout = vt.Layout
+            NextTimestamp = vt.NextTimestamp + 1UL
         }
 
-    static member DereferenceField (name : string) (f : CliValueType) : CliType =
-        // TODO: this is wrong, it doesn't account for overlapping fields
-        f._Fields |> List.find (fun f -> f.Name = name) |> _.Contents
+    // TODO: rewrite this so that it takes a CliConcreteField.
+    // We should eventually be able to dereference an arbitrary field of a struct
+    // as though it were any other field of any other type, to accommodate Unsafe.As.
+    static member DereferenceField (field : string) (cvt : CliValueType) : CliType =
+        let targetField =
+            cvt._Fields
+            |> List.tryFind (fun f -> f.Name = field)
+            |> Option.defaultWith (fun () -> failwithf $"Field '%s{field}' not found")
+
+        // Identify all fields that overlap with the target field's memory range
+        let targetStart = targetField.Offset
+        let targetEnd = targetField.Offset + targetField.Size
+
+        let affectedFields =
+            cvt._Fields
+            |> List.filter (fun f ->
+                let fieldStart = f.Offset
+                let fieldEnd = f.Offset + f.Size
+                // Fields overlap if their ranges intersect
+                fieldStart < targetEnd && targetStart < fieldEnd
+            )
+
+        match affectedFields with
+        | [] -> failwith "unexpectedly didn't dereference a field"
+        | [ f ] -> f.Contents
+        | _ -> failwith "TODO: dereference overlapping fields"
+
+    static member DereferenceFieldAt (offset : int) (size : int) (cvt : CliValueType) : CliType =
+        let targetField =
+            cvt._Fields |> List.tryFind (fun f -> f.Offset = offset && f.Size = size)
+
+        match targetField with
+        | None -> failwith "TODO: couldn't find the field"
+        | Some f -> f.Contents
 
     static member SizeOf (vt : CliValueType) : SizeofResult =
         let minimumSize, packingSize =
@@ -352,53 +413,35 @@ and CliValueType =
                 Alignment = alignment
             }
 
+    /// Sets the value of the specified field, *without* touching any overlapping fields.
+    /// `DereferenceField` handles resolving conflicts between overlapping fields.
     static member WithFieldSet (field : string) (value : CliType) (cvt : CliValueType) : CliValueType =
-        let storageSize = CliType.SizeOf value
-
-        let targetField =
-            cvt._Fields
-            |> List.tryFind (fun f -> f.Name = field)
-            |> Option.defaultWith (fun () -> failwithf $"Field '%s{field}' not found")
-
-        if targetField.Size < storageSize.Size then
-            failwith "TODO: trying to store a value into a field that's too small to contain it"
-
-        // Identify all fields that overlap with the target field's memory range
-        let targetStart = targetField.Offset
-        let targetEnd = targetField.Offset + targetField.Size
-
-        let affectedFields =
-            cvt._Fields
-            |> List.filter (fun f ->
-                let fieldStart = f.Offset
-                let fieldEnd = f.Offset + f.Size
-                // Fields overlap if their ranges intersect
-                fieldStart < targetEnd && targetStart < fieldEnd
-            )
-
-        match affectedFields |> List.tryExactlyOne with
-        | None -> failwith "TODO: overlapping fields"
-        | Some toReplace ->
-            {
-                Layout = cvt.Layout
-                _Fields =
-                    cvt._Fields
-                    |> List.replaceWhere (fun f ->
-                        if f.Name = toReplace.Name then
-                            { f with
-                                Contents = value
-                            }
-                            |> Some
-                        else
-                            None
-                    )
-            }
+        {
+            Layout = cvt.Layout
+            _Fields =
+                cvt._Fields
+                |> List.replaceWhere (fun f ->
+                    if f.Name = field then
+                        { f with
+                            Contents = value
+                            EditedAtTime = cvt.NextTimestamp
+                        }
+                        |> Some
+                    else
+                        None
+                )
+            NextTimestamp = cvt.NextTimestamp + 1UL
+        }
 
     /// To facilitate bodges. This function absolutely should not exist.
     static member TryExactlyOneField (cvt : CliValueType) : CliField option =
         match cvt._Fields with
         | [] -> None
-        | [ x ] -> Some (CliConcreteField.ToCliField x)
+        | [ x ] ->
+            if x.Offset = 0 then
+                Some (CliConcreteField.ToCliField x)
+            else
+                None
         | _ -> None
 
     /// To facilitate bodges. This function absolutely should not exist.
@@ -493,7 +536,7 @@ module CliType =
 
         | ConcreteTypeHandle.Pointer _ ->
             // Pointer types are unmanaged pointers - the zero value is a null pointer
-            CliType.RuntimePointer (CliRuntimePointer.Unmanaged 0L), concreteTypes
+            CliType.RuntimePointer (CliRuntimePointer.Managed ManagedPointerSource.Null), concreteTypes
 
         | ConcreteTypeHandle.Concrete _ ->
             // This is a concrete type - look it up in the mapping
@@ -507,7 +550,10 @@ module CliType =
             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
+            if
+                concreteType.Assembly.FullName = corelib.Corelib.Name.FullName
+                && concreteType.Generics.IsEmpty
+            then
                 // Check against known primitive types
                 if TypeInfo.NominallyEqual typeDef corelib.Boolean then
                     zeroOfPrimitive PrimitiveType.Boolean, concreteTypes

WoofWare.PawPrint/Corelib.fs

@@ -1,5 +1,8 @@
 namespace WoofWare.PawPrint
 
+open System.Collections.Immutable
+open System.Reflection.Metadata
+
 [<RequireQualifiedAccess>]
 module Corelib =
 
@@ -180,3 +183,81 @@ module Corelib =
             IntPtr = intPtrType
             UIntPtr = uintPtrType
         }
+
+    let concretizeAll
+        (loaded : ImmutableDictionary<string, DumpedAssembly>)
+        (bct : BaseClassTypes<DumpedAssembly>)
+        (t : AllConcreteTypes)
+        : AllConcreteTypes
+        =
+        let ctx =
+            {
+                TypeConcretization.ConcretizationContext.InProgress = ImmutableDictionary.Empty
+                TypeConcretization.ConcretizationContext.ConcreteTypes = t
+                TypeConcretization.ConcretizationContext.LoadedAssemblies = loaded
+                TypeConcretization.ConcretizationContext.BaseTypes = bct
+            }
+
+        let loader =
+            { new IAssemblyLoad with
+                member _.LoadAssembly _ _ _ =
+                    failwith "should have already loaded this assembly"
+            }
+
+        let tys =
+            [
+                bct.String
+                bct.Boolean
+                bct.Char
+                bct.SByte
+                bct.Byte
+                bct.Int16
+                bct.UInt16
+                bct.Int32
+                bct.UInt32
+                bct.Int64
+                bct.UInt64
+                bct.Single
+                bct.Double
+                bct.Array
+                bct.Enum
+                bct.ValueType
+                bct.DelegateType
+                bct.Object
+                bct.RuntimeTypeHandle
+                bct.RuntimeMethodHandle
+                bct.RuntimeFieldHandle
+                bct.RuntimeFieldInfoStub
+                bct.RuntimeFieldHandleInternal
+                bct.RuntimeType
+                bct.Void
+                bct.TypedReference
+                bct.IntPtr
+                bct.UIntPtr
+            ]
+
+        (ctx, tys)
+        ||> List.fold (fun ctx ty ->
+            let stk =
+                match DumpedAssembly.resolveBaseType ctx.BaseTypes ctx.LoadedAssemblies ty.Assembly ty.BaseType with
+                | ResolvedBaseType.Enum
+                | ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
+                | ResolvedBaseType.Object
+                | ResolvedBaseType.Delegate -> SignatureTypeKind.Class
+
+            let _handle, ctx =
+                TypeConcretization.concretizeType
+                    ctx
+                    loader
+                    ty.Assembly
+                    ImmutableArray.Empty
+                    ImmutableArray.Empty
+                    (TypeDefn.FromDefinition (
+                        ComparableTypeDefinitionHandle.Make ty.TypeDefHandle,
+                        ty.Assembly.FullName,
+                        stk
+                    ))
+
+            ctx
+        )
+        |> _.ConcreteTypes

WoofWare.PawPrint/EvalStack.fs

@@ -8,7 +8,8 @@ type EvalStackValue =
     | Float of float
     | ManagedPointer of ManagedPointerSource
     | ObjectRef of ManagedHeapAddress
-    | UserDefinedValueType of EvalStackValueUserType
+    /// This doesn't match what the CLR does in reality, but we can work out whatever we need from it.
+    | UserDefinedValueType of CliValueType
 
     override this.ToString () =
         match this with
@@ -18,50 +19,7 @@ type EvalStackValue =
         | EvalStackValue.Float f -> $"Float(%f{f})"
         | EvalStackValue.ManagedPointer managedPointerSource -> $"Pointer(%O{managedPointerSource})"
         | EvalStackValue.ObjectRef managedHeapAddress -> $"ObjectRef(%O{managedHeapAddress})"
-        | EvalStackValue.UserDefinedValueType evalStackValues ->
-            let desc =
-                evalStackValues.Fields
-                |> List.map (_.ContentsEval >> string<EvalStackValue>)
-                |> String.concat " | "
-
-            $"Struct(%s{desc})"
-
-and EvalStackValueField =
-    {
-        Name : string
-        ContentsEval : EvalStackValue
-        Offset : int option
-    }
-
-and EvalStackValueUserType =
-    {
-        Fields : EvalStackValueField list
-        Layout : Layout
-    }
-
-    static member DereferenceField (name : string) (this : EvalStackValueUserType) =
-        // TODO: this doesn't account for overlapping fields
-        this.Fields
-        |> List.pick (fun stackField ->
-            if stackField.Name = name then
-                Some stackField.ContentsEval
-            else
-                None
-        )
-
-    static member OfFields (layout : Layout) (fields : EvalStackValueField list) =
-        {
-            Fields = fields
-            Layout = layout
-        }
-
-    static member TrySequentialFields (cvt : EvalStackValueUserType) : EvalStackValueField list option =
-        let isNone, isSome = cvt.Fields |> List.partition (fun field -> field.Offset.IsNone)
-
-        match isSome with
-        | [] -> Some isNone
-        | [ field ] when field.Offset = Some 0 -> Some [ field ]
-        | _ -> None
+        | EvalStackValue.UserDefinedValueType evalStackValues -> $"Struct(%O{evalStackValues})"
 
 [<RequireQualifiedAccess>]
 module EvalStackValue =
@@ -89,6 +47,7 @@ module EvalStackValue =
                     failwith "todo"
             | NativeIntSource.ManagedPointer _ -> failwith "TODO"
             | NativeIntSource.FunctionPointer _ -> failwith "TODO"
+            | NativeIntSource.FieldHandlePtr _ -> failwith "TODO"
             | NativeIntSource.TypeHandlePtr _ -> failwith "TODO"
         | EvalStackValue.Float f -> failwith "todo"
         | EvalStackValue.ManagedPointer managedPointerSource ->
@@ -134,6 +93,37 @@ module EvalStackValue =
         | EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo"
         | EvalStackValue.UserDefinedValueType evalStackValues -> failwith "todo"
 
+    let rec ofCliType (v : CliType) : EvalStackValue =
+        match v with
+        | CliType.Numeric numeric ->
+            match numeric with
+            | CliNumericType.Int32 i -> EvalStackValue.Int32 i
+            | CliNumericType.Int64 i -> EvalStackValue.Int64 i
+            | CliNumericType.NativeInt i -> EvalStackValue.NativeInt i
+            // Sign-extend types int8 and int16
+            // Zero-extend unsigned int8/unsigned int16
+            | CliNumericType.Int8 b -> int32<int8> b |> EvalStackValue.Int32
+            | CliNumericType.UInt8 b -> int32<uint8> b |> EvalStackValue.Int32
+            | CliNumericType.Int16 s -> int32<int16> s |> EvalStackValue.Int32
+            | CliNumericType.UInt16 s -> int32<uint16> s |> EvalStackValue.Int32
+            | CliNumericType.Float32 f -> EvalStackValue.Float (float<float32> f)
+            | CliNumericType.Float64 f -> EvalStackValue.Float f
+            | CliNumericType.NativeFloat f -> EvalStackValue.Float f
+        | CliType.ObjectRef i ->
+            match i with
+            | None -> EvalStackValue.ManagedPointer ManagedPointerSource.Null
+            | Some i -> EvalStackValue.ManagedPointer (ManagedPointerSource.Heap i)
+        // Zero-extend bool/char
+        | CliType.Bool b -> int32 b |> EvalStackValue.Int32
+        | CliType.Char (high, low) -> int32 high * 256 + int32 low |> EvalStackValue.Int32
+        | CliType.RuntimePointer ptr ->
+            match ptr with
+            | CliRuntimePointer.Verbatim ptrInt -> NativeIntSource.Verbatim ptrInt |> EvalStackValue.NativeInt
+            | CliRuntimePointer.FieldRegistryHandle ptrInt ->
+                NativeIntSource.FieldHandlePtr ptrInt |> EvalStackValue.NativeInt
+            | CliRuntimePointer.Managed ptr -> ptr |> EvalStackValue.ManagedPointer
+        | CliType.ValueType fields -> EvalStackValue.UserDefinedValueType fields
+
     let rec toCliTypeCoerced (target : CliType) (popped : EvalStackValue) : CliType =
         match target with
         | CliType.Numeric numeric ->
@@ -142,23 +132,12 @@ module EvalStackValue =
                 match popped with
                 | EvalStackValue.Int32 i -> CliType.Numeric (CliNumericType.Int32 i)
                 | EvalStackValue.UserDefinedValueType popped ->
-                    match popped.Fields with
-                    | [] -> failwith "unexpectedly empty"
-                    | [ popped ] -> toCliTypeCoerced target popped.ContentsEval
-                    | fields ->
-                        match fields.[0].Offset with
-                        | None -> failwith "TODO"
-                        | Some _ ->
-                            let fields =
-                                fields
-                                |> List.map (fun f ->
-                                    match f.Offset with
-                                    | None -> failwith "unexpectedly got a field which didn't have an offset"
-                                    | Some offset -> offset, f
-                                )
-                                |> List.sortBy fst
-
-                            failwith "TODO"
+                    let popped = CliValueType.DereferenceFieldAt 0 4 popped
+                    // TODO: when we have a general mechanism to coerce CliTypes to each other,
+                    // do that
+                    match popped with
+                    | CliType.Numeric (CliNumericType.Int32 i) -> CliType.Numeric (CliNumericType.Int32 i)
+                    | _ -> failwith "TODO"
                 | i -> failwith $"TODO: %O{i}"
             | CliNumericType.Int64 _ ->
                 match popped with
@@ -168,7 +147,7 @@ module EvalStackValue =
                     | NativeIntSource.Verbatim i -> CliType.Numeric (CliNumericType.Int64 i)
                     | NativeIntSource.ManagedPointer ptr -> failwith "TODO"
                     | NativeIntSource.FunctionPointer f -> failwith $"TODO: {f}"
-                    // CliType.Numeric (CliNumericType.ProvenanceTrackedNativeInt64 f)
+                    | NativeIntSource.FieldHandlePtr f -> failwith $"TODO: {f}"
                     | NativeIntSource.TypeHandlePtr f -> failwith $"TODO: {f}"
                 // CliType.Numeric (CliNumericType.TypeHandlePtr f)
                 | i -> failwith $"TODO: %O{i}"
@@ -179,9 +158,21 @@ module EvalStackValue =
                     CliNumericType.NativeInt (NativeIntSource.ManagedPointer ptrSrc)
                     |> CliType.Numeric
                 | EvalStackValue.UserDefinedValueType vt ->
-                    match vt.Fields with
-                    | [] -> failwith "unexpected"
-                    | [ vt ] -> toCliTypeCoerced target vt.ContentsEval
+                    let popped = CliValueType.DereferenceFieldAt 0 NATIVE_INT_SIZE vt
+                    // TODO: when we have a general mechanism to coerce CliTypes to each other,
+                    // do that
+                    match popped with
+                    | CliType.Numeric (CliNumericType.NativeInt i) -> CliType.Numeric (CliNumericType.NativeInt i)
+                    | CliType.Numeric (CliNumericType.Int64 i) ->
+                        CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.Verbatim i))
+                    | CliType.RuntimePointer ptr ->
+                        match ptr with
+                        | CliRuntimePointer.Verbatim i ->
+                            CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.Verbatim i))
+                        | CliRuntimePointer.FieldRegistryHandle ptr ->
+                            CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.FieldHandlePtr ptr))
+                        | CliRuntimePointer.Managed src ->
+                            CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.ManagedPointer src))
                     | _ -> failwith $"TODO: {popped}"
                 | _ -> failwith $"TODO: {popped}"
             | CliNumericType.NativeFloat f -> failwith "todo"
@@ -223,15 +214,18 @@ module EvalStackValue =
                 | NativeIntSource.Verbatim i -> failwith $"refusing to interpret verbatim native int {i} as a pointer"
                 | NativeIntSource.FunctionPointer _ -> failwith "TODO"
                 | NativeIntSource.TypeHandlePtr _ -> failwith "refusing to interpret type handle ID as an object ref"
+                | NativeIntSource.FieldHandlePtr _ -> failwith "refusing to interpret field handle ID as an object ref"
                 | NativeIntSource.ManagedPointer ptr ->
                     match ptr with
                     | ManagedPointerSource.Null -> CliType.ObjectRef None
                     | ManagedPointerSource.Heap s -> CliType.ObjectRef (Some s)
                     | _ -> failwith "TODO"
             | EvalStackValue.UserDefinedValueType obj ->
-                match obj.Fields with
-                | [ esv ] -> toCliTypeCoerced target esv.ContentsEval
-                | fields -> failwith $"TODO: don't know how to coerce struct of {fields} to a pointer"
+                let popped = CliValueType.DereferenceFieldAt 0 NATIVE_INT_SIZE obj
+
+                match popped with
+                | CliType.ObjectRef r -> CliType.ObjectRef r
+                | _ -> failwith "TODO"
             | _ -> failwith $"TODO: {popped}"
         | CliType.Bool _ ->
             match popped with
@@ -246,11 +240,12 @@ module EvalStackValue =
             | EvalStackValue.ManagedPointer src -> src |> CliRuntimePointer.Managed |> CliType.RuntimePointer
             | EvalStackValue.NativeInt intSrc ->
                 match intSrc with
-                | NativeIntSource.Verbatim i -> CliType.RuntimePointer (CliRuntimePointer.Unmanaged i)
+                | NativeIntSource.Verbatim i -> CliType.RuntimePointer (CliRuntimePointer.Verbatim i)
                 | NativeIntSource.ManagedPointer src -> src |> CliRuntimePointer.Managed |> CliType.RuntimePointer
                 | NativeIntSource.FunctionPointer methodInfo ->
                     CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.FunctionPointer methodInfo))
                 | NativeIntSource.TypeHandlePtr int64 -> failwith "todo"
+                | NativeIntSource.FieldHandlePtr int64 -> failwith "todo"
             | EvalStackValue.ObjectRef addr ->
                 ManagedPointerSource.Heap addr
                 |> CliRuntimePointer.Managed
@@ -266,7 +261,7 @@ module EvalStackValue =
         | CliType.ValueType vt ->
             match popped with
             | EvalStackValue.UserDefinedValueType popped' ->
-                match CliValueType.TrySequentialFields vt, EvalStackValueUserType.TrySequentialFields popped' with
+                match CliValueType.TrySequentialFields vt, CliValueType.TrySequentialFields popped' with
                 | Some vt, Some popped ->
                     if vt.Length <> popped.Length then
                         failwith
@@ -280,7 +275,7 @@ module EvalStackValue =
                         if field1.Offset <> popped.Offset then
                             failwith $"TODO: offset mismatch for {field1.Name}, {field1.Offset} vs {popped.Offset}"
 
-                        let contents = toCliTypeCoerced field1.Contents popped.ContentsEval
+                        let contents = toCliTypeCoerced field1.Contents (ofCliType popped.Contents)
 
                         {
                             CliField.Name = field1.Name
@@ -296,49 +291,6 @@ module EvalStackValue =
                 | Some field -> toCliTypeCoerced field.Contents popped
                 | _ -> failwith $"TODO: {popped} into value type {target}"
 
-    let rec ofCliType (v : CliType) : EvalStackValue =
-        match v with
-        | CliType.Numeric numeric ->
-            match numeric with
-            | CliNumericType.Int32 i -> EvalStackValue.Int32 i
-            | CliNumericType.Int64 i -> EvalStackValue.Int64 i
-            | CliNumericType.NativeInt i -> EvalStackValue.NativeInt i
-            // Sign-extend types int8 and int16
-            // Zero-extend unsigned int8/unsigned int16
-            | CliNumericType.Int8 b -> int32<int8> b |> EvalStackValue.Int32
-            | CliNumericType.UInt8 b -> int32<uint8> b |> EvalStackValue.Int32
-            | CliNumericType.Int16 s -> int32<int16> s |> EvalStackValue.Int32
-            | CliNumericType.UInt16 s -> int32<uint16> s |> EvalStackValue.Int32
-            | CliNumericType.Float32 f -> EvalStackValue.Float (float<float32> f)
-            | CliNumericType.Float64 f -> EvalStackValue.Float f
-            | CliNumericType.NativeFloat f -> EvalStackValue.Float f
-        | CliType.ObjectRef i ->
-            match i with
-            | None -> EvalStackValue.ManagedPointer ManagedPointerSource.Null
-            | Some i -> EvalStackValue.ManagedPointer (ManagedPointerSource.Heap i)
-        // Zero-extend bool/char
-        | CliType.Bool b -> int32 b |> EvalStackValue.Int32
-        | CliType.Char (high, low) -> int32 high * 256 + int32 low |> EvalStackValue.Int32
-        | CliType.RuntimePointer ptr ->
-            match ptr with
-            | CliRuntimePointer.Unmanaged ptrInt -> NativeIntSource.Verbatim ptrInt |> EvalStackValue.NativeInt
-            | CliRuntimePointer.Managed ptr -> ptr |> EvalStackValue.ManagedPointer
-        | CliType.ValueType fields ->
-            // The only allowable use of _Fields
-            fields._Fields
-            |> List.map (fun field ->
-                let contents = ofCliType field.Contents
-
-                {
-                    Name = field.Name
-                    // TODO: this probably wants to be a real offset
-                    Offset = field.ConfiguredOffset
-                    ContentsEval = contents
-                }
-            )
-            |> EvalStackValueUserType.OfFields fields.Layout
-            |> EvalStackValue.UserDefinedValueType
-
 type EvalStack =
     {
         Values : EvalStackValue list

WoofWare.PawPrint/EvalStackValueComparisons.fs

@@ -123,24 +123,14 @@ module EvalStackValueComparisons =
     let rec ceq (var1 : EvalStackValue) (var2 : EvalStackValue) : bool =
         // Table III.4
         match var1, var2 with
-        | EvalStackValue.UserDefinedValueType {
-                                                  Fields = [ f ]
-                                              },
-          v -> ceq f.ContentsEval v
-        | u,
-          EvalStackValue.UserDefinedValueType {
-                                                  Fields = [ f ]
-                                              } -> ceq u f.ContentsEval
-        | EvalStackValue.UserDefinedValueType {
-                                                  Fields = []
-                                              },
-          EvalStackValue.UserDefinedValueType {
-                                                  Fields = []
-                                              } ->
-            // hmm, surely this can't happen, but :shrug:
-            true
-        | EvalStackValue.UserDefinedValueType _, _
-        | _, EvalStackValue.UserDefinedValueType _ -> failwith $"TODO: ceq {var1} vs {var2}"
+        | EvalStackValue.UserDefinedValueType var1, v ->
+            match CliValueType.TryExactlyOneField var1 with
+            | None -> failwith "TODO"
+            | Some var1 -> ceq (EvalStackValue.ofCliType var1.Contents) v
+        | u, EvalStackValue.UserDefinedValueType var2 ->
+            match CliValueType.TryExactlyOneField var2 with
+            | None -> failwith "TODO"
+            | Some var2 -> ceq u (EvalStackValue.ofCliType var2.Contents)
         | EvalStackValue.Int32 var1, EvalStackValue.Int32 var2 -> var1 = var2
         | EvalStackValue.Int32 var1, EvalStackValue.NativeInt var2 -> failwith "TODO: int32 CEQ nativeint"
         | EvalStackValue.Int32 _, _ -> failwith $"bad ceq: Int32 vs {var2}"

WoofWare.PawPrint/FieldHandleRegistry.fs

@@ -88,7 +88,7 @@ module FieldHandleRegistry =
             // https://github.com/dotnet/runtime/blob/2b21c73fa2c32fa0195e4a411a435dda185efd08/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L1380
             {
                 Name = "m_handle"
-                Contents = CliType.RuntimePointer (CliRuntimePointer.Unmanaged newHandle)
+                Contents = CliType.RuntimePointer (CliRuntimePointer.FieldRegistryHandle newHandle)
                 Offset = None // no struct layout was specified
             }
             |> List.singleton

WoofWare.PawPrint/Intrinsics.fs

@@ -157,9 +157,9 @@ module Intrinsics =
                 let rec go (arg : EvalStackValue) =
                     match arg with
                     | EvalStackValue.UserDefinedValueType vt ->
-                        match vt.Fields with
-                        | [ field ] -> go field.ContentsEval
-                        | _ -> failwith $"TODO: %O{vt}"
+                        match CliValueType.TryExactlyOneField vt with
+                        | None -> failwith "TODO"
+                        | Some field -> go (EvalStackValue.ofCliType field.Contents)
                     | EvalStackValue.ManagedPointer ManagedPointerSource.Null -> failwith "TODO: throw NRE"
                     | EvalStackValue.ObjectRef addr
                     | EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) -> Some addr
@@ -358,16 +358,10 @@ module Intrinsics =
                     | EvalStackValue.ManagedPointer src -> IlMachineState.dereferencePointer state src
                     | EvalStackValue.NativeInt src -> failwith "TODO"
                     | EvalStackValue.ObjectRef ptr -> failwith "TODO"
-                    | EvalStackValue.UserDefinedValueType {
-                                                              Fields = [ f ]
-                                                          } -> go f.ContentsEval
-                    | EvalStackValue.UserDefinedValueType {
-                                                              Fields = []
-                                                          } -> failwith "unexpected no-fields object"
-                    | EvalStackValue.UserDefinedValueType {
-                                                              Fields = _ :: _ :: _
-                                                          } ->
-                        failwith "TODO: check overlapping fields to see if this is a pointer"
+                    | EvalStackValue.UserDefinedValueType vt ->
+                        match CliValueType.TryExactlyOneField vt with
+                        | None -> failwith "TODO"
+                        | Some field -> go (EvalStackValue.ofCliType field.Contents)
                     | EvalStackValue.Int32 _
                     | EvalStackValue.Int64 _
                     | EvalStackValue.Float _ -> failwith $"this isn't a pointer! {ptr}"

WoofWare.PawPrint/NullaryIlOp.fs

@@ -118,7 +118,6 @@ module NullaryIlOp =
         | EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo"
 
     let internal ldElem
-        (targetCliTypeZero : CliType)
         (index : EvalStackValue)
         (arr : EvalStackValue)
         (currentThread : ThreadId)
@@ -130,6 +129,7 @@ module NullaryIlOp =
             | EvalStackValue.NativeInt src ->
                 match src with
                 | NativeIntSource.FunctionPointer _
+                | NativeIntSource.FieldHandlePtr _
                 | NativeIntSource.TypeHandlePtr _
                 | NativeIntSource.ManagedPointer _ -> failwith "Refusing to treat a pointer as an array index"
                 | NativeIntSource.Verbatim i -> i |> int32
@@ -166,6 +166,7 @@ module NullaryIlOp =
             | EvalStackValue.NativeInt src ->
                 match src with
                 | NativeIntSource.FunctionPointer _
+                | NativeIntSource.FieldHandlePtr _
                 | NativeIntSource.TypeHandlePtr _
                 | NativeIntSource.ManagedPointer _ -> failwith "Refusing to treat a pointer as an array index"
                 | NativeIntSource.Verbatim i -> i |> int32
@@ -950,7 +951,7 @@ module NullaryIlOp =
             let index, state = IlMachineState.popEvalStack currentThread state
             let arr, state = IlMachineState.popEvalStack currentThread state
 
-            ldElem (CliType.ObjectRef None) index arr currentThread state
+            ldElem index arr currentThread state
         | Stelem_i ->
             let value, state = IlMachineState.popEvalStack currentThread state
             let index, state = IlMachineState.popEvalStack currentThread state

WoofWare.PawPrint/Program.fs

@@ -302,6 +302,11 @@ module Program =
 
         logger.LogInformation "Main method class now initialised"
 
+        let state =
+            { state with
+                ConcreteTypes = Corelib.concretizeAll state._LoadedAssemblies baseClassTypes state.ConcreteTypes
+            }
+
         // Now that BCL initialisation has taken place and the user-code classes are constructed,
         // overwrite the main thread completely using the already-concretized method.
         let methodState =

WoofWare.PawPrint/UnaryMetadataIlOp.fs

@@ -795,9 +795,9 @@ module internal UnaryMetadataIlOp =
                     IlMachineState.pushToEvalStack currentValue thread state
                 | EvalStackValue.ManagedPointer (ManagedPointerSource.InterpretedAsType (src, ty)) -> failwith "TODO"
                 | EvalStackValue.UserDefinedValueType vt ->
-                    let result = vt |> EvalStackValueUserType.DereferenceField field.Name
+                    let result = vt |> CliValueType.DereferenceField field.Name
 
-                    IlMachineState.pushToEvalStack' result thread state
+                    IlMachineState.pushToEvalStack result thread state
 
             state
             |> IlMachineState.advanceProgramCounter thread

WoofWare.PawPrint/WoofWare.PawPrint.fsproj

@@ -10,7 +10,6 @@
     <Compile Include="List.fs" />
     <Compile Include="ImmutableArray.fs" />
     <Compile Include="Result.fs" />
-    <Compile Include="Constants.fs" />
     <Compile Include="Corelib.fs" />
     <Compile Include="AbstractMachineDomain.fs" />
     <Compile Include="BasicCliType.fs" />