Use System.Reflection.Emit

benchmarks/FSharp.SystemTextJson.Benchmarks/Program.fs

@@ -22,6 +22,12 @@ type TestRecord =
       thing: bool option
       time: System.DateTimeOffset }
 
+[<Struct>]
+type TestStructRecord = 
+    { name: string
+      thing: bool voption
+      time: System.DateTimeOffset }
+
 type SimpleClass() =
     member val Name: string = null with get, set
     member val Thing: bool option = None with get, set
@@ -34,22 +40,31 @@ type ArrayTestBase<'t>(instance: 't) =
         options
 
 
-    [<Params(10,100)>]
+    [<Params(10,100,1000)>]
     member val ArrayLength = 0 with get, set
 
     member val InstanceArray = [||] with get, set
+
+    member val Serialized = "" with get, set
 
     [<GlobalSetup>]
     member this.InitArray () = 
         this.InstanceArray <- Array.replicate this.ArrayLength instance
+        this.Serialized <- this.InstanceArray |> JsonConvert.SerializeObject
+
+    [<Benchmark>]
+    member this.Serialize_Newtonsoft () = JsonConvert.SerializeObject this.InstanceArray
 
     [<Benchmark>]
-    member this.Newtonsoft () = JsonConvert.SerializeObject this.InstanceArray
+    member this.Serialize_SystemTextJson () = System.Text.Json.JsonSerializer.Serialize(this.InstanceArray, systemTextOptions)
 
     [<Benchmark>]
-    member this.SystemTextJson () = System.Text.Json.JsonSerializer.Serialize(this.InstanceArray, systemTextOptions)
+    member this.Deserialize_Newtonsoft () = JsonConvert.DeserializeObject<'t[]> this.Serialized
 
-let recordInstance = 
+    [<Benchmark>]
+    member this.Deserialize_SystemTextJson () = System.Text.Json.JsonSerializer.Deserialize<'t[]>(this.Serialized, systemTextOptions)
+
+let recordInstance : TestRecord = 
     { name = "sample"
       thing = Some true
       time = System.DateTimeOffset.UnixEpoch.AddDays(200.) }
@@ -58,6 +73,14 @@ let recordInstance =
 type Records () =
     inherit ArrayTestBase<TestRecord>(recordInstance)
 
+let recordStructInstance : TestStructRecord = 
+    { name = "sample"
+      thing = ValueSome true
+      time = System.DateTimeOffset.UnixEpoch.AddDays(200.) }
+
+type StructRecords () =
+    inherit ArrayTestBase<TestStructRecord>(recordStructInstance)
+
 type Classes() =
     inherit ArrayTestBase<SimpleClass>(SimpleClass(Name = "sample", Thing = Some true, Time = DateTimeOffset.UnixEpoch.AddDays(200.)))
 
@@ -97,7 +120,7 @@ let config =
             .With(ExecutionValidator.FailOnError)
 
 let defaultSwitch () =
-    BenchmarkSwitcher([| typeof<Records>; typeof<Classes>; typeof<ReflectionComparison> |])
+    BenchmarkSwitcher([| typeof<Records>; typeof<StructRecords>; typeof<Classes>; typeof<ReflectionComparison> |])
 
 
 [<EntryPoint>]

benchmarks/FSharp.SystemTextJson.Benchmarks/paket.references

@@ -1,3 +1,4 @@
 FSharp.Core
 BenchmarkDotNet
-Newtonsoft.Json
+Newtonsoft.Json
+BenchmarkDotNet.Diagnostics.Windows

build.fsx

@@ -73,13 +73,19 @@ Target.create "Test" (fun _ ->
 
 /// This target doesn't need a dependency chain, because the benchmarks actually wrap and build the referenced
 /// project(s) as part of the run.
-Target.create "Benchmark" (fun _ ->
-    DotNet.exec (fun o -> { o with 
-                                WorkingDirectory = Paths.benchmarks } ) "run" "-c release --filter \"*\""
+Target.create "Benchmark" (fun p ->
+    let args = p.Context.Arguments
+    seq {
+        yield! ["-p"; Paths.benchmarks; "-c"; "release"; "--"]
+        if not (List.contains "-f" args || List.contains "--filter" args) then
+            yield! ["--filter"; "*"]
+        yield! args
+    }
+    |> Args.toWindowsCommandLine
+    |> DotNet.exec id "run"
     |> fun r -> 
-        if r.OK 
-        then () 
-        else failwithf "Benchmarks failed with code %d:\n%A" r.ExitCode r.Errors
+        if not r.OK then
+            failwithf "Benchmarks failed with code %d:\n%A" r.ExitCode r.Errors
 )
 
 Target.create "All" ignore

paket.dependencies

@@ -2,6 +2,7 @@ frameworks netstandard2.0, netcoreapp3.0
 storage none
 source https://api.nuget.org/v3/index.json
 nuget FsCheck.XUnit
+nuget BenchmarkDotNet.Diagnostics.Windows
 nuget FSharp.Core ~> 4.7.0
 nuget Microsoft.NET.Test.Sdk ~> 16.3.0
 nuget Microsoft.SourceLink.GitHub prerelease copy_local:true

paket.lock

@@ -20,6 +20,9 @@ NUGET
       System.Xml.XmlSerializer (>= 4.3)
       System.Xml.XPath.XmlDocument (>= 4.3)
     BenchmarkDotNet.Annotations (0.11.5)
+    BenchmarkDotNet.Diagnostics.Windows (0.11.5)
+      BenchmarkDotNet (>= 0.11.5)
+      Microsoft.Diagnostics.Tracing.TraceEvent (>= 2.0.34)
     CommandLineParser (2.6)
     FsCheck (2.14)
       FSharp.Core (>= 4.2.3)

src/FSharp.SystemTextJson/FSharp.SystemTextJson.fsproj

@@ -8,6 +8,7 @@
     <Compile Include="Helpers.fs" />
     <Compile Include="Collection.fs" />
     <Compile Include="Tuple.fs" />
+    <Compile Include="Record.Reflection.fs" />
     <Compile Include="Record.fs" />
     <Compile Include="Union.fs" />
     <Compile Include="All.fs" />

src/FSharp.SystemTextJson/Record.Reflection.fs

@@ -0,0 +1,145 @@
+namespace System.Text.Json.Serialization
+
+open System
+open System.Reflection
+open FSharp.Reflection
+open System.Reflection.Emit
+open System.Text.Json
+
+type internal RefobjFieldGetter<'Record, 'Field> = Func<'Record, 'Field>
+type internal StructFieldGetter<'Record, 'Field> = delegate of inref<'Record> -> 'Field
+
+type internal RefobjSerializer<'Record> = Action<Utf8JsonWriter, 'Record, JsonSerializerOptions>
+type internal StructSerializer<'Record> = delegate of Utf8JsonWriter * inref<'Record> * JsonSerializerOptions -> unit
+
+[<Struct>]
+type internal Serializer<'Record> =
+    | SStruct of s: StructSerializer<'Record>
+    | SRefobj of n: RefobjSerializer<'Record>
+
+type internal RefobjFieldSetter<'Record, 'Field> = Action<'Record, 'Field>
+type internal StructFieldSetter<'Record, 'Field> = delegate of byref<'Record> * 'Field -> unit
+
+type internal RefobjDeserializer<'Record> = delegate of byref<Utf8JsonReader> * 'Record * JsonSerializerOptions -> unit
+type internal StructDeserializer<'Record> = delegate of byref<Utf8JsonReader> * byref<'Record> * JsonSerializerOptions -> unit
+
+[<Struct>]
+type internal Deserializer<'Record> =
+    | DStruct of s: StructDeserializer<'Record>
+    | DRefobj of n: RefobjDeserializer<'Record>
+
+type internal RecordField<'Record> =
+    {
+        Name: string
+        Type: Type
+        Ignore: bool
+        Serialize: Serializer<'Record>
+        Deserialize: Deserializer<'Record>
+    }
+
+module internal RecordReflection =
+
+    let private name (p: PropertyInfo) =
+        match p.GetCustomAttributes(typeof<JsonPropertyNameAttribute>, true) with
+        | [| :? JsonPropertyNameAttribute as name |] -> name.Name
+        | _ -> p.Name
+
+    let private isIgnore (p: PropertyInfo) =
+        p.GetCustomAttributes(typeof<JsonIgnoreAttribute>, true)
+        |> Array.isEmpty
+        |> not
+
+    let private deserializer<'Record, 'Field> (f: FieldInfo) =
+        let setter =
+            let dynMethod =
+                new DynamicMethod(
+                    f.Name,
+                    typeof<Void>,
+                    [|
+                        (if f.DeclaringType.IsValueType
+                            then typeof<'Record>.MakeByRefType()
+                            else typeof<'Record>)
+                        f.FieldType
+                    |],
+                    typedefof<RecordField<_>>.Module,
+                    skipVisibility = true
+                )
+            let gen = dynMethod.GetILGenerator()
+            gen.Emit(OpCodes.Ldarg_0)
+            gen.Emit(OpCodes.Ldarg_1)
+            gen.Emit(OpCodes.Stfld, f)
+            gen.Emit(OpCodes.Ret)
+            dynMethod
+        if f.DeclaringType.IsValueType then
+            let setter = setter.CreateDelegate(typeof<StructFieldSetter<'Record, 'Field>>) :?> StructFieldSetter<'Record, 'Field>
+            StructDeserializer<'Record>(fun reader record options ->
+                let value = JsonSerializer.Deserialize<'Field>(&reader, options)
+                setter.Invoke(&record, value))
+            |> DStruct
+        else
+            let setter = setter.CreateDelegate(typeof<RefobjFieldSetter<'Record, 'Field>>) :?> RefobjFieldSetter<'Record, 'Field>
+            RefobjDeserializer<'Record>(fun reader record options ->
+                let value = JsonSerializer.Deserialize<'Field>(&reader, options)
+                setter.Invoke(record, value))
+            |> DRefobj
+
+    let private serializer<'Record, 'Field> (f: FieldInfo) =
+        let getter =
+            let dynMethod =
+                new DynamicMethod(
+                    f.Name,
+                    f.FieldType,
+                    [|
+                        (if f.DeclaringType.IsValueType
+                            then typeof<'Record>.MakeByRefType()
+                            else typeof<'Record>)
+                    |],
+                    typedefof<RecordField<_>>.Module,
+                    skipVisibility = true
+                )
+            let gen = dynMethod.GetILGenerator()
+            gen.Emit(OpCodes.Ldarg_0)
+            gen.Emit(OpCodes.Ldfld, f)
+            gen.Emit(OpCodes.Ret)
+            dynMethod
+        if f.DeclaringType.IsValueType then
+            let getter = getter.CreateDelegate(typeof<StructFieldGetter<'Record, 'Field>>) :?> StructFieldGetter<'Record, 'Field>
+            StructSerializer<'Record>(fun writer record options ->
+                let v = getter.Invoke(&record)
+                JsonSerializer.Serialize<'Field>(writer, v, options)
+            )
+            |> SStruct
+        else
+            let getter = getter.CreateDelegate(typeof<RefobjFieldGetter<'Record, 'Field>>) :?> RefobjFieldGetter<'Record, 'Field>
+            RefobjSerializer<'Record>(fun writer record options ->
+                let v = getter.Invoke(record)
+                JsonSerializer.Serialize<'Field>(writer, v, options)
+            )
+            |> SRefobj
+
+    let private thisModule = typedefof<RecordField<_>>.Assembly.GetType("System.Text.Json.Serialization.RecordReflection")
+
+    let fields<'Record> () =
+        let recordTy = typeof<'Record>
+        let fields = recordTy.GetFields(BindingFlags.Instance ||| BindingFlags.NonPublic)
+        let props = FSharpType.GetRecordFields(recordTy, true)
+        (fields, props)
+        ||> Array.map2 (fun f p ->
+            let serializer =
+                thisModule.GetMethod("serializer", BindingFlags.Static ||| BindingFlags.NonPublic)
+                    .MakeGenericMethod(recordTy, p.PropertyType)
+                    .Invoke(null, [|f|])
+                    :?> Serializer<'Record>
+            let deserializer =
+                thisModule.GetMethod("deserializer", BindingFlags.Static ||| BindingFlags.NonPublic)
+                    .MakeGenericMethod(recordTy, p.PropertyType)
+                    .Invoke(null, [|f|])
+                    :?> Deserializer<'Record>
+            {
+                Name = name p
+                Type = p.PropertyType
+                Ignore = isIgnore p
+                Serialize = serializer
+                Deserialize = deserializer
+            } : RecordField<'Record>
+        )

src/FSharp.SystemTextJson/Record.fs

@@ -1,49 +1,40 @@
 namespace System.Text.Json.Serialization
 
 open System
+open System.Runtime.Serialization
 open System.Text.Json
 open FSharp.Reflection
-
-type internal RecordProperty =
-    {
-        Name: string
-        Type: Type
-        Ignore: bool
-    }
+open System.Collections.Generic
 
 type JsonRecordConverter<'T>() =
     inherit JsonConverter<'T>()
 
-    static let fieldProps =
-        FSharpType.GetRecordFields(typeof<'T>, true)
-        |> Array.map (fun p ->
-            let name =
-                match p.GetCustomAttributes(typeof<JsonPropertyNameAttribute>, true) with
-                | [| :? JsonPropertyNameAttribute as name |] -> name.Name
-                | _ -> p.Name
-            let ignore =
-                p.GetCustomAttributes(typeof<JsonIgnoreAttribute>, true)
-                |> Array.isEmpty
-                |> not
-            { Name = name; Type = p.PropertyType; Ignore = ignore }
-        )
+    static let ty = typeof<'T>
+
+    static let fields = RecordReflection.fields<'T>()
+
+    static let fieldIndices = Dictionary(StringComparer.InvariantCulture)
+    static do fields |> Array.iteri (fun i f ->
+        fieldIndices.[f.Name] <- f)
 
     static let expectedFieldCount =
-        fieldProps
+        fields
         |> Seq.filter (fun p -> not p.Ignore)
         |> Seq.length
 
-    static let ctor = FSharpValue.PreComputeRecordConstructor(typeof<'T>, true)
-
-    static let dector = FSharpValue.PreComputeRecordReader(typeof<'T>, true)
+    static let ctor =
+        if ty.IsValueType then
+            fun () -> Unchecked.defaultof<'T>
+        else
+            fun () -> FormatterServices.GetUninitializedObject(ty) :?> 'T
 
     static let fieldIndex (reader: byref<Utf8JsonReader>) =
         let mutable found = ValueNone
         let mutable i = 0
-        while found.IsNone && i < fieldProps.Length do
-            let p = fieldProps.[i]
+        while found.IsNone && i < fields.Length do
+            let p = fields.[i]
             if reader.ValueTextEquals(p.Name.AsSpan()) then
-                found <- ValueSome (struct (i, p))
+                found <- ValueSome p
             else
                 i <- i + 1
         found
@@ -52,7 +43,7 @@ type JsonRecordConverter<'T>() =
         if reader.TokenType <> JsonTokenType.StartObject then
             raise (JsonException("Failed to parse record type " + typeToConvert.FullName + ", expected JSON object, found " + string reader.TokenType))
 
-        let fields = Array.zeroCreate fieldProps.Length
+        let mutable res = ctor()
         let mutable cont = true
         let mutable fieldsFound = 0
         while cont && reader.Read() do
@@ -61,24 +52,27 @@ type JsonRecordConverter<'T>() =
                 cont <- false
             | JsonTokenType.PropertyName ->
                 match fieldIndex &reader with
-                | ValueSome (i, p) when not p.Ignore ->
+                | ValueSome p when not p.Ignore ->
                     fieldsFound <- fieldsFound + 1
-                    fields.[i] <- JsonSerializer.Deserialize(&reader, p.Type, options)
+                    match p.Deserialize with
+                    | DStruct p -> p.Invoke(&reader, &res, options)
+                    | DRefobj p -> p.Invoke(&reader, res, options)
                 | _ ->
                     reader.Skip()
             | _ -> ()
 
         if fieldsFound < expectedFieldCount then
             raise (JsonException("Missing field for record type " + typeToConvert.FullName))
-        ctor fields :?> 'T
+        res
 
     override __.Write(writer, value, options) =
         writer.WriteStartObject()
-        (fieldProps, dector value)
-        ||> Array.iter2 (fun p v ->
+        for p in fields do
             if not p.Ignore then
                 writer.WritePropertyName(p.Name)
-                JsonSerializer.Serialize(writer, v, options))
+                match p.Serialize with
+                | SStruct p -> p.Invoke(writer, &value, options)
+                | SRefobj p -> p.Invoke(writer, value, options)
         writer.WriteEndObject()
 
 type JsonRecordConverter() =

src/FSharp.SystemTextJson/paket.references

@@ -1,3 +1,5 @@
 FSharp.Core
 System.Text.Json framework: = netstandard2.0
-Microsoft.SourceLink.GitHub
+System.Reflection.Emit.Lightweight framework: = netstandard2.0
+System.Reflection.Emit.ILGeneration framework: = netstandard2.0
+Microsoft.SourceLink.GitHub