From 6f48c89ef3e2f08f2183e274a0dde982635c2c04 Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Sun, 10 Aug 2025 23:22:04 +0100 Subject: [PATCH] More --- .../TypeConcretisation.fs | 102 ++++++++++++++++++ WoofWare.PawPrint/Intrinsics.fs | 89 ++++++++++----- 2 files changed, 165 insertions(+), 26 deletions(-) diff --git a/WoofWare.PawPrint.Domain/TypeConcretisation.fs b/WoofWare.PawPrint.Domain/TypeConcretisation.fs index 24f1525..ac76eda 100644 --- a/WoofWare.PawPrint.Domain/TypeConcretisation.fs +++ b/WoofWare.PawPrint.Domain/TypeConcretisation.fs @@ -132,6 +132,108 @@ module ConcreteActivePatterns = | None -> None | _ -> None + let (|ConcreteBool|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option = + match handle with + | ConcreteTypeHandle.Concrete id -> + match concreteTypes.Mapping |> Map.tryFind id with + | Some ct -> + if + ct.Assembly.Name = "System.Private.CoreLib" + && ct.Namespace = "System" + && ct.Name = "Boolean" + && ct.Generics.IsEmpty + then + Some () + else + None + | None -> None + | _ -> None + + let (|ConcreteString|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option = + match handle with + | ConcreteTypeHandle.Concrete id -> + match concreteTypes.Mapping |> Map.tryFind id with + | Some ct -> + if + ct.Assembly.Name = "System.Private.CoreLib" + && ct.Namespace = "System" + && ct.Name = "String" + && ct.Generics.IsEmpty + then + Some () + else + None + | None -> None + | _ -> None + + let (|ConcreteDouble|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option = + match handle with + | ConcreteTypeHandle.Concrete id -> + match concreteTypes.Mapping |> Map.tryFind id with + | Some ct -> + if + ct.Assembly.Name = "System.Private.CoreLib" + && ct.Namespace = "System" + && ct.Name = "Double" + && ct.Generics.IsEmpty + then + Some () + else + None + | None -> None + | _ -> None + + let (|ConcreteInt64|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option = + match handle with + | ConcreteTypeHandle.Concrete id -> + match concreteTypes.Mapping |> Map.tryFind id with + | Some ct -> + if + ct.Assembly.Name = "System.Private.CoreLib" + && ct.Namespace = "System" + && ct.Name = "Int64" + && ct.Generics.IsEmpty + then + Some () + else + None + | None -> None + | _ -> None + + let (|ConcreteInt32|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option = + match handle with + | ConcreteTypeHandle.Concrete id -> + match concreteTypes.Mapping |> Map.tryFind id with + | Some ct -> + if + ct.Assembly.Name = "System.Private.CoreLib" + && ct.Namespace = "System" + && ct.Name = "Int32" + && ct.Generics.IsEmpty + then + Some () + else + None + | None -> None + | _ -> None + + let (|ConcreteSingle|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option = + match handle with + | ConcreteTypeHandle.Concrete id -> + match concreteTypes.Mapping |> Map.tryFind id with + | Some ct -> + if + ct.Assembly.Name = "System.Private.CoreLib" + && ct.Namespace = "System" + && ct.Name = "Single" + && ct.Generics.IsEmpty + then + Some () + else + None + | None -> None + | _ -> None + /// Active pattern to match byref types let (|ConcreteByref|_|) (handle : ConcreteTypeHandle) = match handle with diff --git a/WoofWare.PawPrint/Intrinsics.fs b/WoofWare.PawPrint/Intrinsics.fs index e8be9bf..7f343d9 100644 --- a/WoofWare.PawPrint/Intrinsics.fs +++ b/WoofWare.PawPrint/Intrinsics.fs @@ -44,6 +44,11 @@ module Intrinsics = match methodToCall.DeclaringType.Assembly.Name, methodToCall.DeclaringType.Name, methodToCall.Name with | "System.Private.CoreLib", "Type", "get_TypeHandle" -> + // TODO: check return type is RuntimeTypeHandle + match methodToCall.Signature.ParameterTypes with + | _ :: _ -> failwith "bad signature Type.get_TypeHandle" + | _ -> () + // https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/Type.cs#L470 // no args, returns RuntimeTypeHandle, a struct with a single field (a RuntimeType class) @@ -97,6 +102,10 @@ module Intrinsics = |> IlMachineState.advanceProgramCounter currentThread |> Some | "System.Private.CoreLib", "BitConverter", "SingleToInt32Bits" -> + match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with + | [ ConcreteSingle state.ConcreteTypes ], ConcreteInt32 state.ConcreteTypes -> () + | _ -> failwith "bad signature BitConverter.SingleToInt32Bits" + let arg, state = IlMachineState.popEvalStack currentThread state let result = @@ -109,6 +118,10 @@ module Intrinsics = |> IlMachineState.advanceProgramCounter currentThread |> Some | "System.Private.CoreLib", "BitConverter", "Int32BitsToSingle" -> + match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with + | [ ConcreteInt32 state.ConcreteTypes ], ConcreteSingle state.ConcreteTypes -> () + | _ -> failwith "bad signature BitConverter.Int64BitsToSingle" + let arg, state = IlMachineState.popEvalStack currentThread state let arg = @@ -124,6 +137,10 @@ module Intrinsics = |> IlMachineState.advanceProgramCounter currentThread |> Some | "System.Private.CoreLib", "BitConverter", "Int64BitsToDouble" -> + match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with + | [ ConcreteInt64 state.ConcreteTypes ], ConcreteDouble state.ConcreteTypes -> () + | _ -> failwith "bad signature BitConverter.Int64BitsToDouble" + let arg, state = IlMachineState.popEvalStack currentThread state let arg = @@ -139,6 +156,10 @@ module Intrinsics = |> IlMachineState.advanceProgramCounter currentThread |> Some | "System.Private.CoreLib", "BitConverter", "DoubleToInt64Bits" -> + match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with + | [ ConcreteDouble state.ConcreteTypes ], ConcreteInt64 state.ConcreteTypes -> () + | _ -> failwith "bad signature BitConverter.DoubleToInt64Bits" + let arg, state = IlMachineState.popEvalStack currentThread state let result = @@ -151,35 +172,39 @@ module Intrinsics = |> IlMachineState.advanceProgramCounter currentThread |> Some | "System.Private.CoreLib", "String", "Equals" -> - let arg1, state = IlMachineState.popEvalStack currentThread state + match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with + | [ ConcreteString state.ConcreteTypes ; ConcreteString state.ConcreteTypes ], + ConcreteBool state.ConcreteTypes -> + let arg1, state = IlMachineState.popEvalStack currentThread state - let arg1 = - match arg1 with - | EvalStackValue.ObjectRef h - | EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h - | EvalStackValue.Int32 _ - | EvalStackValue.Int64 _ - | EvalStackValue.Float _ -> failwith $"this isn't a string! {arg1}" - | _ -> failwith $"TODO: %O{arg1}" + let arg1 = + match arg1 with + | EvalStackValue.ObjectRef h + | EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h + | EvalStackValue.Int32 _ + | EvalStackValue.Int64 _ + | EvalStackValue.Float _ -> failwith $"this isn't a string! {arg1}" + | _ -> failwith $"TODO: %O{arg1}" - let arg2, state = IlMachineState.popEvalStack currentThread state + let arg2, state = IlMachineState.popEvalStack currentThread state - let arg2 = - match arg2 with - | EvalStackValue.ObjectRef h - | EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h - | EvalStackValue.Int32 _ - | EvalStackValue.Int64 _ - | EvalStackValue.Float _ -> failwith $"this isn't a string! {arg2}" - | _ -> failwith $"TODO: %O{arg2}" + let arg2 = + match arg2 with + | EvalStackValue.ObjectRef h + | EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h + | EvalStackValue.Int32 _ + | EvalStackValue.Int64 _ + | EvalStackValue.Float _ -> failwith $"this isn't a string! {arg2}" + | _ -> failwith $"TODO: %O{arg2}" - if arg1 = arg2 then - state - |> IlMachineState.pushToEvalStack (CliType.ofBool true) currentThread - |> IlMachineState.advanceProgramCounter currentThread - |> Some - else - failwith "TODO" + if arg1 = arg2 then + state + |> IlMachineState.pushToEvalStack (CliType.ofBool true) currentThread + |> IlMachineState.advanceProgramCounter currentThread + |> Some + else + failwith "TODO" + | _ -> None | "System.Private.CoreLib", "Unsafe", "ReadUnaligned" -> let ptr, state = IlMachineState.popEvalStack currentThread state @@ -232,7 +257,19 @@ module Intrinsics = | _ -> failwith "TODO: unexpected params to String.op_Implicit" | "System.Private.CoreLib", "RuntimeHelpers", "IsReferenceOrContainsReferences" -> // https://github.com/dotnet/runtime/blob/1d1bf92fcf43aa6981804dc53c5174445069c9e4/src/coreclr/System.Private.CoreLib/src/System/Runtime/CompilerServices/RuntimeHelpers.CoreCLR.cs#L207 - failwith "TODO: get generic type parameter and then do the thing" + match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with + | [], ConcreteBool state.ConcreteTypes -> () + | _ -> failwith "bad signature for System.Private.CoreLib.RuntimeHelpers.IsReferenceOrContainsReference" + + let generic = + AllConcreteTypes.lookup (Seq.exactlyOne methodToCall.Generics) state.ConcreteTypes + + let generic = + match generic with + | None -> failwith "somehow have not already concretised type in IsReferenceOrContainsReferences" + | Some generic -> generic + + failwith $"TODO: do the thing on %O{generic}" | "System.Private.CoreLib", "RuntimeHelpers", "InitializeArray" -> // https://github.com/dotnet/runtime/blob/9e5e6aa7bc36aeb2a154709a9d1192030c30a2ef/src/coreclr/System.Private.CoreLib/src/System/Runtime/CompilerServices/RuntimeHelpers.CoreCLR.cs#L18 failwith "TODO: array initialization"