Implement Sizeof (#92)

2025-10-05 14:18:40 +00:00 · 2025-07-04 19:08:56 +01:00
parent 30b8ec990f
commit de1eefb436
16 changed files with 456 additions and 239 deletions
--- a/WoofWare.PawPrint.Domain/ConcreteType.fs
+++ b/WoofWare.PawPrint.Domain/ConcreteType.fs
@@ -1,6 +1,7 @@
 namespace WoofWare.PawPrint

 open System
+open System.Collections.Immutable
 open System.Reflection
 open System.Reflection.Metadata

@@ -30,12 +31,12 @@ type ConcreteType<'typeGeneric when 'typeGeneric : comparison and 'typeGeneric :
            /// Do not use this, because it's intended to be private; use the accessor `.Namespace` instead.
            _Namespace : string
            /// Do not use this, because it's intended to be private; use the accessor `.Generics` instead.
-            _Generics : 'typeGeneric list
+            _Generics : 'typeGeneric ImmutableArray
        }

    member this.Assembly : AssemblyName = this._AssemblyName
    member this.Definition : ComparableTypeDefinitionHandle = this._Definition
-    member this.Generics : 'typeGeneric list = this._Generics
+    member this.Generics : 'typeGeneric ImmutableArray = this._Generics
    member this.Name = this._Name
    member this.Namespace = this._Namespace

@@ -65,8 +66,8 @@ type ConcreteType<'typeGeneric when 'typeGeneric : comparison and 'typeGeneric :
                comp
            else

-            let thisGen = (this._Generics : 'typeGeneric list) :> IComparable<'typeGeneric list>
-            thisGen.CompareTo other._Generics
+            let thisGen = this._Generics |> Seq.toList :> IComparable<'typeGeneric list>
+            thisGen.CompareTo (other._Generics |> Seq.toList)

    interface IComparable with
        member this.CompareTo other =
@@ -82,7 +83,7 @@ module ConcreteType =
        (ns : string)
        (name : string)
        (defn : TypeDefinitionHandle)
-        (generics : TypeDefn list)
+        (generics : TypeDefn ImmutableArray)
        : ConcreteType<TypeDefn>
        =
        {
@@ -106,7 +107,7 @@ module ConcreteType =
            _Definition = ComparableTypeDefinitionHandle.Make defn
            _Name = name
            _Namespace = ns
-            _Generics = List.replicate genericParamCount FakeUnit.FakeUnit
+            _Generics = Seq.replicate genericParamCount FakeUnit.FakeUnit |> ImmutableArray.CreateRange
        }

    let mapGeneric<'a, 'b
@@ -115,7 +116,7 @@ module ConcreteType =
        (x : ConcreteType<'a>)
        : ConcreteType<'b>
        =
-        let generics = x._Generics |> List.mapi f
+        let generics = x._Generics |> Seq.mapi f |> ImmutableArray.CreateRange

        {
            _AssemblyName = x._AssemblyName
--- a/WoofWare.PawPrint.Domain/TypeConcretisation.fs
+++ b/WoofWare.PawPrint.Domain/TypeConcretisation.fs
@@ -46,7 +46,7 @@ module AllConcreteTypes =

    let findExistingConcreteType
        (concreteTypes : AllConcreteTypes)
-        (asm : AssemblyName, ns : string, name : string, generics : ConcreteTypeHandle list as key)
+        (asm : AssemblyName, ns : string, name : string, generics : ConcreteTypeHandle ImmutableArray as key)
        : ConcreteTypeHandle option
        =
        concreteTypes.Mapping
@@ -95,7 +95,7 @@ module TypeConcretization =
        (assembly : AssemblyName)
        (ns : string)
        (name : string)
-        (generics : ConcreteTypeHandle list)
+        (generics : ConcreteTypeHandle ImmutableArray)
        : ConcreteTypeHandle option
        =
        concreteTypes.Mapping
@@ -118,7 +118,7 @@ module TypeConcretization =
        : ConcreteTypeHandle option
        =
        let (asm, ns, name) = key
-        findExistingType concreteTypes asm ns name []
+        findExistingType concreteTypes asm ns name ImmutableArray.Empty

    // Helper function to create and add a ConcreteType to the context
    let private createAndAddConcreteType
@@ -127,7 +127,7 @@ module TypeConcretization =
        (definition : ComparableTypeDefinitionHandle)
        (ns : string)
        (name : string)
-        (generics : ConcreteTypeHandle list)
+        (generics : ConcreteTypeHandle ImmutableArray)
        : ConcreteTypeHandle * ConcretizationContext
        =
        let concreteType =
@@ -229,7 +229,7 @@ module TypeConcretization =
                (ComparableTypeDefinitionHandle.Make typeInfo.TypeDefHandle)
                typeInfo.Namespace
                typeInfo.Name
-                [] // Primitives have no generic parameters
+                ImmutableArray.Empty // Primitives have no generic parameters

    let private concretizeArray
        (ctx : ConcretizationContext)
@@ -248,7 +248,7 @@ module TypeConcretization =
                arrayTypeInfo.Assembly
                arrayTypeInfo.Namespace
                arrayTypeInfo.Name
-                [ elementHandle ]
+                (ImmutableArray.Create elementHandle)
        with
        | Some handle -> handle, ctx
        | None ->
@@ -259,7 +259,7 @@ module TypeConcretization =
                (ComparableTypeDefinitionHandle.Make arrayTypeInfo.TypeDefHandle)
                arrayTypeInfo.Namespace
                arrayTypeInfo.Name
-                [ elementHandle ] // Array<T> has one generic parameter
+                (ImmutableArray.Create elementHandle) // Array<T> has one generic parameter

    let private concretizeOneDimArray
        (ctx : ConcretizationContext)
@@ -278,7 +278,7 @@ module TypeConcretization =
                arrayTypeInfo.Assembly
                arrayTypeInfo.Namespace
                arrayTypeInfo.Name
-                [ elementHandle ]
+                (ImmutableArray.Create elementHandle)
        with
        | Some handle -> handle, ctx
        | None ->
@@ -289,7 +289,7 @@ module TypeConcretization =
                (ComparableTypeDefinitionHandle.Make arrayTypeInfo.TypeDefHandle)
                arrayTypeInfo.Namespace
                arrayTypeInfo.Name
-                [ elementHandle ] // Array<T> has one generic parameter
+                (ImmutableArray.Create elementHandle) // Array<T> has one generic parameter

    let concretizeTypeDefinition
        (ctx : ConcretizationContext)
@@ -315,11 +315,17 @@ module TypeConcretization =
                typeInfo.Generics.Length

        // Check if we've already concretized this type
-        match findExistingType ctx.ConcreteTypes assemblyName typeInfo.Namespace typeInfo.Name [] with
+        match findExistingType ctx.ConcreteTypes assemblyName typeInfo.Namespace typeInfo.Name ImmutableArray.Empty 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
+            createAndAddConcreteType
+                ctx
+                assemblyName
+                typeDefHandle
+                typeInfo.Namespace
+                typeInfo.Name
+                ImmutableArray.Empty // No generic parameters

    let private concretizeTypeReference
        (loadAssembly :
@@ -422,7 +428,12 @@ module TypeConcretization =
            let voidTypeInfo = ctx.BaseTypes.Void

            match
-                findExistingType ctx.ConcreteTypes voidTypeInfo.Assembly voidTypeInfo.Namespace voidTypeInfo.Name []
+                findExistingType
+                    ctx.ConcreteTypes
+                    voidTypeInfo.Assembly
+                    voidTypeInfo.Namespace
+                    voidTypeInfo.Name
+                    ImmutableArray.Empty
            with
            | Some handle -> handle, ctx
            | None ->
@@ -433,7 +444,7 @@ module TypeConcretization =
                    (ComparableTypeDefinitionHandle.Make voidTypeInfo.TypeDefHandle)
                    voidTypeInfo.Namespace
                    voidTypeInfo.Name
-                    [] // Void has no generic parameters
+                    ImmutableArray.Empty // Void has no generic parameters

        | _ -> failwithf "TODO: Concretization of %A not implemented" typeDefn

@@ -460,7 +471,7 @@ module TypeConcretization =
                )
                ([], ctx)

-        let argHandles = argHandles |> List.rev
+        let argHandles = argHandles |> Seq.rev |> ImmutableArray.CreateRange

        // Get the base type definition
        let baseAssembly, baseTypeDefHandle, baseNamespace, baseName, ctxAfterArgs =
@@ -891,7 +902,7 @@ module Concretization =
                // Recursively convert generic arguments
                let genericArgs =
                    concreteType.Generics
-                    |> List.map (fun h -> concreteHandleToTypeDefn baseClassTypes h concreteTypes assemblies)
+                    |> Seq.map (fun h -> concreteHandleToTypeDefn baseClassTypes h concreteTypes assemblies)
                    |> ImmutableArray.CreateRange

                let baseDef =
--- a/WoofWare.PawPrint.Domain/TypeDefn.fs
+++ b/WoofWare.PawPrint.Domain/TypeDefn.fs
@@ -149,6 +149,28 @@ type PrimitiveType =
        | PrimitiveType.UIntPtr -> "uintptr"
        | PrimitiveType.Object -> "obj"

+[<RequireQualifiedAccess>]
+module PrimitiveType =
+    let sizeOf (pt : PrimitiveType) : int =
+        match pt with
+        | PrimitiveType.Boolean -> 1
+        | PrimitiveType.Char -> 2
+        | PrimitiveType.SByte -> 1
+        | PrimitiveType.Byte -> 1
+        | PrimitiveType.Int16 -> 2
+        | PrimitiveType.UInt16 -> 2
+        | PrimitiveType.Int32 -> 4
+        | PrimitiveType.UInt32 -> 4
+        | PrimitiveType.Int64 -> 8
+        | PrimitiveType.UInt64 -> 8
+        | PrimitiveType.Single -> 4
+        | PrimitiveType.Double -> 8
+        | PrimitiveType.String -> 8
+        | PrimitiveType.TypedReference -> failwith "todo"
+        | PrimitiveType.IntPtr -> 8
+        | PrimitiveType.UIntPtr -> 8
+        | PrimitiveType.Object -> 8
+
 type TypeDefn =
    | PrimitiveType of PrimitiveType
    // TODO: array shapes